KIDS Distribution saved on May 04, 2018@13:02:07 VistA Imaging 3.0 - Patch 210 **KIDS**:MAG*3.0*210^ **INSTALL NAME** MAG*3.0*210 "BLD",8374,0) MAG*3.0*210^IMAGING^0^3180504^y "BLD",8374,1,0) ^^9^9^3180503^ "BLD",8374,1,1,0) VistA Imaging V3.0 - Patch 210 "BLD",8374,1,2,0) "BLD",8374,1,3,0) Routines: "BLD",8374,1,4,0) "BLD",8374,1,5,0) MAGDHOW1 "BLD",8374,1,6,0) MAGIP210 "BLD",8374,1,7,0) "BLD",8374,1,8,0) Please note that routine MAGIP210 is deleted after the KIDS build is "BLD",8374,1,9,0) installed. "BLD",8374,4,0) ^9.64PA^^ "BLD",8374,6.3) 3 "BLD",8374,"ABNS",0) ^9.66A^^ "BLD",8374,"ABPKG") y^y^G.IMAGING DEVELOPMENT TEAM@DOMAIN.EXT "BLD",8374,"INID") n^y^n "BLD",8374,"INIT") POS^MAGIP210 "BLD",8374,"KRN",0) ^9.67PA^779.2^20 "BLD",8374,"KRN",.4,0) .4 "BLD",8374,"KRN",.401,0) .401 "BLD",8374,"KRN",.402,0) .402 "BLD",8374,"KRN",.403,0) .403 "BLD",8374,"KRN",.5,0) .5 "BLD",8374,"KRN",.84,0) .84 "BLD",8374,"KRN",3.6,0) 3.6 "BLD",8374,"KRN",3.8,0) 3.8 "BLD",8374,"KRN",9.2,0) 9.2 "BLD",8374,"KRN",9.8,0) 9.8 "BLD",8374,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",8374,"KRN",9.8,"NM",1,0) MAGDHOW1^^0^B28769840 "BLD",8374,"KRN",9.8,"NM","B","MAGDHOW1",1) "BLD",8374,"KRN",19,0) 19 "BLD",8374,"KRN",19.1,0) 19.1 "BLD",8374,"KRN",101,0) 101 "BLD",8374,"KRN",409.61,0) 409.61 "BLD",8374,"KRN",771,0) 771 "BLD",8374,"KRN",779.2,0) 779.2 "BLD",8374,"KRN",870,0) 870 "BLD",8374,"KRN",8989.51,0) 8989.51 "BLD",8374,"KRN",8989.52,0) 8989.52 "BLD",8374,"KRN",8994,0) 8994 "BLD",8374,"KRN","B",.4,.4) "BLD",8374,"KRN","B",.401,.401) "BLD",8374,"KRN","B",.402,.402) "BLD",8374,"KRN","B",.403,.403) "BLD",8374,"KRN","B",.5,.5) "BLD",8374,"KRN","B",.84,.84) "BLD",8374,"KRN","B",3.6,3.6) "BLD",8374,"KRN","B",3.8,3.8) "BLD",8374,"KRN","B",9.2,9.2) "BLD",8374,"KRN","B",9.8,9.8) "BLD",8374,"KRN","B",19,19) "BLD",8374,"KRN","B",19.1,19.1) "BLD",8374,"KRN","B",101,101) "BLD",8374,"KRN","B",409.61,409.61) "BLD",8374,"KRN","B",771,771) "BLD",8374,"KRN","B",779.2,779.2) "BLD",8374,"KRN","B",870,870) "BLD",8374,"KRN","B",8989.51,8989.51) "BLD",8374,"KRN","B",8989.52,8989.52) "BLD",8374,"KRN","B",8994,8994) "BLD",8374,"QUES",0) ^9.62^^ "BLD",8374,"REQB",0) ^9.611^1^1 "BLD",8374,"REQB",1,0) MAG*3.0*180^2 "BLD",8374,"REQB","B","MAG*3.0*180",1) "INIT") POS^MAGIP210 "MBREQ") 0 "PKG",454,-1) 1^1 "PKG",454,0) IMAGING^MAG^Imaging-V1 to release "PKG",454,20,0) ^9.402P^^ "PKG",454,22,0) ^9.49I^1^1 "PKG",454,22,1,0) 3.0^3020319^3020517^126 "PKG",454,22,1,"PAH",1,0) 210^3180504^126 "PKG",454,22,1,"PAH",1,1,0) ^^9^9^3180504 "PKG",454,22,1,"PAH",1,1,1,0) VistA Imaging V3.0 - Patch 210 "PKG",454,22,1,"PAH",1,1,2,0) "PKG",454,22,1,"PAH",1,1,3,0) Routines: "PKG",454,22,1,"PAH",1,1,4,0) "PKG",454,22,1,"PAH",1,1,5,0) MAGDHOW1 "PKG",454,22,1,"PAH",1,1,6,0) MAGIP210 "PKG",454,22,1,"PAH",1,1,7,0) "PKG",454,22,1,"PAH",1,1,8,0) Please note that routine MAGIP210 is deleted after the KIDS build is "PKG",454,22,1,"PAH",1,1,9,0) installed. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 2 "RTN","MAGDHOW1") 0^1^B28769840 "RTN","MAGDHOW1",1,0) MAGDHOW1 ;WOIFO/PMK/DAC - Capture Consult/Procedure Request data ; May 03, 2018 "RTN","MAGDHOW1",2,0) ;;3.0;IMAGING;**138,174,180,210**;Mar 19, 2002;Build 3 "RTN","MAGDHOW1",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGDHOW1",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGDHOW1",5,0) ;; | Property of the US Government. | "RTN","MAGDHOW1",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGDHOW1",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGDHOW1",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGDHOW1",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGDHOW1",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGDHOW1",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGDHOW1",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGDHOW1",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGDHOW1",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGDHOW1",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGDHOW1",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGDHOW1",17,0) ;; "RTN","MAGDHOW1",18,0) MSGSETUP(GMRCIEN,SERVICE,ORC1,ORC5,APTSCHED) ; called by ^MAGDHOWC and ^MAGDHOWS "RTN","MAGDHOW1",19,0) ; setup to send a message, if required "RTN","MAGDHOW1",20,0) N CONSULT,CPTIEN,DATETIME,DIVISION,FMDATE,FMDATETM "RTN","MAGDHOW1",21,0) N HL7SUBLIST,I,ITYPCODE,ITYPNAME,MSGTYPE,OBXSEGNO "RTN","MAGDHOW1",22,0) N ORCTRL,ORSTATUS,ORIGSERV,PARMS,SEGMENT,SENDIT,X,Y,Z "RTN","MAGDHOW1",23,0) ; "RTN","MAGDHOW1",24,0) S FMDATETM=$$NOW^XLFDT(),FMDATE=FMDATETM\1 "RTN","MAGDHOW1",25,0) S MSGTYPE="ORM" ; HL7 message type for orders "RTN","MAGDHOW1",26,0) ; "RTN","MAGDHOW1",27,0) ; decide if service is one that requires HL7->DICOM gateway and PACS "RTN","MAGDHOW1",28,0) ; "RTN","MAGDHOW1",29,0) S SENDIT=$$SERVICE(SERVICE,GMRCIEN,.DIVISION,.ITYPNAME,.ITYPCODE,.CPTIEN,.HL7SUBLIST) "RTN","MAGDHOW1",30,0) ; "RTN","MAGDHOW1",31,0) I SENDIT D ; send this transaction via HL7 to DICOM gateway and PACS "RTN","MAGDHOW1",32,0) . ; check for an "OK" order control value which indicates a new order "RTN","MAGDHOW1",33,0) . I ORC1="OK" D "RTN","MAGDHOW1",34,0) . . S ORCTRL="NW" ; order control "RTN","MAGDHOW1",35,0) . . S ORSTATUS="IP" ; order status "RTN","MAGDHOW1",36,0) . . Q "RTN","MAGDHOW1",37,0) . ; "RTN","MAGDHOW1",38,0) . ; check for a cancelled or discontinued request "RTN","MAGDHOW1",39,0) . E I " CA CR DR OC OD "[(" "_ORC1_" ") D "RTN","MAGDHOW1",40,0) . . ; P210 DAC - Instead of Killing FILLER2, it will now be set to cancelled "RTN","MAGDHOW1",41,0) . . S FILLER2="GMRC-CANCELLED" "RTN","MAGDHOW1",42,0) . . S ORCTRL="CA" ; order control "RTN","MAGDHOW1",43,0) . . S ORSTATUS="CA" ; order status "RTN","MAGDHOW1",44,0) . . Q "RTN","MAGDHOW1",45,0) . ; "RTN","MAGDHOW1",46,0) . ; check for scheduled request (set in ^MAGDHOWS) "RTN","MAGDHOW1",47,0) . E I ORC1="XO",ORC5="SC" D "RTN","MAGDHOW1",48,0) . . S ORCTRL="XO" ; order control "RTN","MAGDHOW1",49,0) . . S ORSTATUS="SC" ; order status "RTN","MAGDHOW1",50,0) . . Q "RTN","MAGDHOW1",51,0) . ; "RTN","MAGDHOW1",52,0) . ; look for a result message "RTN","MAGDHOW1",53,0) . E I ORC1="RE" D ; result "RTN","MAGDHOW1",54,0) . . S MSGTYPE="ORU" ; HL7 message type for results "RTN","MAGDHOW1",55,0) . . ; "RTN","MAGDHOW1",56,0) . . I (ORC5="A")!($$UNSIGNED^MAGDGMRC(GMRCIEN)) D ; P180 DAC - Process unsigned TIU notes "RTN","MAGDHOW1",57,0) . . . S FILLER2="GMRC-NEW UNSIGNED RESULT" "RTN","MAGDHOW1",58,0) . . . S ORCTRL="RE" ; order control "RTN","MAGDHOW1",59,0) . . . S ORSTATUS="A" ; order status "RTN","MAGDHOW1",60,0) . . . Q "RTN","MAGDHOW1",61,0) . . E D ; new signed TIU note "RTN","MAGDHOW1",62,0) . . . K FILLER2 ; P174 DAC - remove any preset status like GMRC-SCHEDULED set in CHECKAPT^MAGDHOWC "RTN","MAGDHOW1",63,0) . . . S ORCTRL="RE" ; order control "RTN","MAGDHOW1",64,0) . . . S ORSTATUS="CM" ; order status "RTN","MAGDHOW1",65,0) . . . Q "RTN","MAGDHOW1",66,0) . . Q "RTN","MAGDHOW1",67,0) . ; "RTN","MAGDHOW1",68,0) . E D ; default "RTN","MAGDHOW1",69,0) . . S ORCTRL="SC" ; order control "RTN","MAGDHOW1",70,0) . . S ORSTATUS="IP" ; order status "RTN","MAGDHOW1",71,0) . . Q "RTN","MAGDHOW1",72,0) . D MESSAGE^MAGDHOW2(SERVICE) "RTN","MAGDHOW1",73,0) . Q "RTN","MAGDHOW1",74,0) ; "RTN","MAGDHOW1",75,0) I ORC1="RE" D ; do this for all consult results "RTN","MAGDHOW1",76,0) . ; link any outstanding DICOM images to the new TIU note "RTN","MAGDHOW1",77,0) . S I=$$NEWTIU^MAGDHOW0(GMRCIEN) "RTN","MAGDHOW1",78,0) . Q "RTN","MAGDHOW1",79,0) ; "RTN","MAGDHOW1",80,0) Q "RTN","MAGDHOW1",81,0) ; "RTN","MAGDHOW1",82,0) SERVICE(SERVICE,GMRCIEN,DIVISION,ITYPNAME,ITYPCODE,CPTIEN,HL7SUBLIST) ; "RTN","MAGDHOW1",83,0) ; check if the service is in the DICOM Clinical Service dictionary, and "RTN","MAGDHOW1",84,0) ; if so, then get all of the attributes "RTN","MAGDHOW1",85,0) N MWLCONFIG,SENDIT,X,Y,Z "RTN","MAGDHOW1",86,0) S (DIVISION,ITYPNAME,ITYPCODE,CPTIEN,HL7SUBLIST,SENDIT)=0 "RTN","MAGDHOW1",87,0) I SERVICE D ; ignore SERVICE if it is null "RTN","MAGDHOW1",88,0) . S MWLCONFIG=$$MWLFIND(SERVICE,GMRCIEN) "RTN","MAGDHOW1",89,0) . S DIVISION="" "RTN","MAGDHOW1",90,0) . I MWLCONFIG D ; send order "RTN","MAGDHOW1",91,0) . . S X=$G(^MAG(2006.5831,MWLCONFIG,0)) "RTN","MAGDHOW1",92,0) . . S DIVISION=$P(X,"^",5),CPTIEN=$P(X,"^",6),HL7SUBLIST=$P(X,"^",7) "RTN","MAGDHOW1",93,0) . . I HL7SUBLIST,$$GET1^DIQ(779.4,HL7SUBLIST,.01)="" S HL7SUBLIST=0 ; absent "RTN","MAGDHOW1",94,0) . . I 'HL7SUBLIST D ; lookup default HL7 subscription list "RTN","MAGDHOW1",95,0) . . . N DIC,DO,X,Y "RTN","MAGDHOW1",96,0) . . . S DIC=779.4,DIC(0)="BX",X="MAGD DEFAULT" D ^DIC "RTN","MAGDHOW1",97,0) . . . S HL7SUBLIST=$P(Y,"^",1) ; Y should equal "^MAGD DEFAULT" "RTN","MAGDHOW1",98,0) . . . Q "RTN","MAGDHOW1",99,0) . . ; get specialty index and procedure index (if available, otherwise, use 0) "RTN","MAGDHOW1",100,0) . . S Y=$P(X,"^",3) "RTN","MAGDHOW1",101,0) . . S ITYPNAME=$P(^MAG(2005.84,Y,0),"^",1) "RTN","MAGDHOW1",102,0) . . S ITYPCODE=$P(^MAG(2005.84,Y,2),"^",1) "RTN","MAGDHOW1",103,0) . . S Z=$P(X,"^",4) "RTN","MAGDHOW1",104,0) . . I Z D ; get procedure name and code "RTN","MAGDHOW1",105,0) . . . S ITYPNAME=ITYPNAME_" -- "_$P(^MAG(2005.85,Z,0),"^",1) "RTN","MAGDHOW1",106,0) . . . S ITYPCODE=ITYPCODE_"/"_$P(^MAG(2005.85,Z,2),"^",1) "RTN","MAGDHOW1",107,0) . . . Q "RTN","MAGDHOW1",108,0) . . S SENDIT=1 "RTN","MAGDHOW1",109,0) . . Q "RTN","MAGDHOW1",110,0) . Q "RTN","MAGDHOW1",111,0) Q SENDIT "RTN","MAGDHOW1",112,0) ; "RTN","MAGDHOW1",113,0) MWLFIND(SERVICE,GMRCIEN) ; lookup 2006.5831 entry by service and procedure "RTN","MAGDHOW1",114,0) ; ordering a procedure and the 2006.5831 procedure entry are optional "RTN","MAGDHOW1",115,0) N PROCEDURE "RTN","MAGDHOW1",116,0) S PROCEDURE=+$$GET1^DIQ(123,GMRCIEN,4,"I") "RTN","MAGDHOW1",117,0) Q $$IREQUEST(SERVICE,PROCEDURE) ; pointer to modality worklist dictionary file #2006.5831 "RTN","MAGDHOW1",118,0) ; "RTN","MAGDHOW1",119,0) IREQUEST(SERVICE,PROCEDURE) ; return the IEN of the consult or procedure for the request service "RTN","MAGDHOW1",120,0) N IEN,LIST "RTN","MAGDHOW1",121,0) ; "RTN","MAGDHOW1",122,0) S SERVICE=$G(SERVICE) I 'SERVICE Q 0 "RTN","MAGDHOW1",123,0) ; "RTN","MAGDHOW1",124,0) ; if this is a lookup for a procedure, just return the "C" cross reference "RTN","MAGDHOW1",125,0) S PROCEDURE=$G(PROCEDURE) "RTN","MAGDHOW1",126,0) I PROCEDURE Q $O(^MAG(2006.5831,"C",SERVICE,PROCEDURE,"")) "RTN","MAGDHOW1",127,0) ; "RTN","MAGDHOW1",128,0) ; use the "B" cross reference to make a list of all IENs for the request service "RTN","MAGDHOW1",129,0) S IEN="" F S IEN=$O(^MAG(2006.5831,"B",SERVICE,IEN)) Q:IEN="" S LIST(IEN)="" "RTN","MAGDHOW1",130,0) ; "RTN","MAGDHOW1",131,0) ; use the "C" cross reference to delete the IENs for the procedures "RTN","MAGDHOW1",132,0) S PROCEDURE="" F S PROCEDURE=$O(^MAG(2006.5831,"C",SERVICE,PROCEDURE)) Q:PROCEDURE="" D "RTN","MAGDHOW1",133,0) . S IEN=$O(^MAG(2006.5831,"C",SERVICE,PROCEDURE,"")) "RTN","MAGDHOW1",134,0) . K LIST(IEN) ; remove the procedures from the list "RTN","MAGDHOW1",135,0) . Q "RTN","MAGDHOW1",136,0) ; "RTN","MAGDHOW1",137,0) ; return what is left in the list, which should be the consult, if there is one "RTN","MAGDHOW1",138,0) Q $O(LIST("")) "RTN","MAGIP210") 0^^B4110345 "RTN","MAGIP210",1,0) MAGIP210 ;WOIFO/DAC - Install code for MAG*3.0*210 ; 03 May 2018 10:05 AM "RTN","MAGIP210",2,0) ;;3.0;IMAGING;**210**;Mar 19, 2002;Build 3 "RTN","MAGIP210",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGIP210",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGIP210",5,0) ;; | Property of the US Government. | "RTN","MAGIP210",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGIP210",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGIP210",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGIP210",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGIP210",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGIP210",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGIP210",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGIP210",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGIP210",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGIP210",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGIP210",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGIP210",17,0) ;; "RTN","MAGIP210",18,0) ; There are no environment checks here but the MAGIP210 has to be "RTN","MAGIP210",19,0) ; referenced by the "Environment Check Routine" field of the KIDS "RTN","MAGIP210",20,0) ; build so that entry points of the routine are available to the "RTN","MAGIP210",21,0) ; KIDS during all installation phases. "RTN","MAGIP210",22,0) Q "RTN","MAGIP210",23,0) ; "RTN","MAGIP210",24,0) ;+++++ INSTALLATION ERROR HANDLING "RTN","MAGIP210",25,0) ERROR ; "RTN","MAGIP210",26,0) S:$D(XPDNM) XPDABORT=1 "RTN","MAGIP210",27,0) ;--- Display the messages and store them to the INSTALL file "RTN","MAGIP210",28,0) D DUMP^MAGUERR1(),ABTMSG^MAGKIDS() "RTN","MAGIP210",29,0) Q "RTN","MAGIP210",30,0) ; "RTN","MAGIP210",31,0) ;***** POST-INSTALL CODE "RTN","MAGIP210",32,0) POS ; "RTN","MAGIP210",33,0) N CALLBACK "RTN","MAGIP210",34,0) D CLEAR^MAGUERR(1) "RTN","MAGIP210",35,0) ; "RTN","MAGIP210",36,0) ;--- Send the notification e-mail "RTN","MAGIP210",37,0) D BMES^XPDUTL("Post Install Mail Message: "_$$FMTE^XLFDT($$NOW^XLFDT)) "RTN","MAGIP210",38,0) D INS^MAGQBUT4(XPDNM,DUZ,$$NOW^XLFDT,XPDA) "RTN","MAGIP210",39,0) Q "RTN","MAGIP210",40,0) ; "RTN","MAGIP210",41,0) ;***** PRE-INSTALL CODE "RTN","MAGIP210",42,0) PRE ; "RTN","MAGIP210",43,0) Q "VER") 8.0^22.2 **END** **END**