source: FOIAVistA/tag/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY142.m@ 636

ORY142 ; SLC/MKB - inits for ED pre-patch OR*3*142 ;7/3/02  13:57
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**142**;Dec 17, 1997
 ;DBIA reference section
 ;2263 - XPAR
 ;2058 - ^DIC(9.4,"C"
 ;10013- DIK
 ;10014- DIU2
 ;10112- VASITE
 ;10103- XLFDT
 ;
PRE ; -- preinit
 I '$O(^ORD(101.41,"AB","OR GTX EVENT",0)) D  ;1st install
 . N DIU ;remove old 100.5, 100.6 DD's
 . F DIU="^ORYX(""ORTO"",","^ORYX(""ORPAR""," S DIU(0)="DST" D EN^DIU2
 Q
 ;
DLGSEND(X)      ; -- Return true if the order dialog should be sent
 I X="OR GTX EVENT" Q 1
 I X="OR GXMOVE EVENT" Q 1
 Q 0
 ;
DCSEND(X)       ; -- Return true if order reason should be sent
 I X="ORDEATH" Q 1
 I X="OROR" Q 1
 I X="ORPASS" Q 1
 I X="ORASIH" Q 1
 Q 0
 ;
PRMSEND(X)      ; -- Return true if parameter definition should be sent
 I X="ORWDX WRITE ORDERS EVENT LIST" Q 1
 I X="OREVNT DEFAULT" Q 1
 Q 0
 ;
POST ; -- postinit to convert old DC parameters to file #100.6
 ;    Creates a set of rules for [primary] division
 ;
 Q:$O(^ORD(100.6,0))  ;not 1st install
 N ORI,ORADMIT,ORDIS,ORTRANS,ORSPEC,ORDEATH,OROR,ORPASS,ORASIH,ORPARM,ORNOW,ORDIV,ORPKG,DIK,ORGLOB,I
 F ORI="ORADMIT","ORDIS","ORTRANS","ORSPEC","ORDEATH","OROR","ORPASS","ORASIH" S @ORI=+$O(^ORD(100.03,"C",ORI,0))
 D GETLST^XPAR(.ORPARM,"ALL","OR DC ON SPEC CHANGE")
 S ORPARM("T")=$$GET^XPAR("ALL","ORPF DC OF GENERIC ORDERS")
 S ORPARM("A")=$$GET^XPAR("ALL","OR DC GEN ORD ON ADMISSION")
 S ORI=0,ORNOW=+$$NOW^XLFDT,ORDIV=+$$SITE^VASITE Q:ORDIV<1
P1 ; -- ADMISSION rule
 S ORI=ORI+1,^ORD(100.6,ORI,0)="ADMISSION^A^"_ORDIV_U_ORADMIT_"^ADMISSION"
 D MVTYPES(ORI,"8^9^15^18^28^29^30^36^39")
 S ORPKG=1,ORPKG(1)=+$O(^DIC(9.4,"C","OR",0))_"^1" D PKGS(ORI,.ORPKG)
 I ORPARM("A")<1 S ^ORD(100.6,ORI,1)=ORNOW ;inactive
 E  S ^ORD(100.6,ORI,2,0)="^100.61DA^1^1",^(1,0)=ORNOW
P2 ; -- SPECIALTY CHANGE rule
 S ORI=ORI+1,^ORD(100.6,ORI,0)="SPECIALTY CHANGE^S^"_ORDIV_U_ORSPEC_"^SPECIALTY CHANGE"
 D MVTYPES(ORI,"20"),PKGS(ORI,.ORPARM)
 I ORPARM<1 S ^ORD(100.6,ORI,1)=ORNOW ;inactive
 E  S ^ORD(100.6,ORI,2,0)="^100.61DA^1^1",^(1,0)=ORNOW
P3 ; -- WARD TRANSFER rule
 S ORI=ORI+1,^ORD(100.6,ORI,0)="WARD TRANSFER^T^"_ORDIV_U_ORTRANS_"^WARD TRANSFER"
 D MVTYPES(ORI,"4")
 S ORPKG=1,ORPKG(1)=+$O(^DIC(9.4,"C","OR",0))_"^1" D PKGS(ORI,.ORPKG)
 I ORPARM("T")<1 S ^ORD(100.6,ORI,1)=ORNOW ;inactive
 E  S ^ORD(100.6,ORI,2,0)="^100.61DA^1^1",^(1,0)=ORNOW
P4 ; -- DISCHARGE rule
 S ORI=ORI+1,^ORD(100.6,ORI,0)="DISCHARGE^D^"_ORDIV_U_ORDIS_"^DISCHARGE"
 D MVTYPES(ORI,"10^11^16^17^21^27^31^32^33^34^35^37^42^46^47")
 F I="1^OR","2^FH" S ORPKG(+I)=+$O(^DIC(9.4,"C",$P(I,U,2),0))_"^1"
 S ORPKG=2 D PKGS(ORI,.ORPKG)
 S ^ORD(100.6,ORI,2,0)="^100.61DA^1^1",^(1,0)=ORNOW ;active
P5 ; -- DEATH rule
 S ORI=ORI+1,^ORD(100.6,ORI,0)="DEATH^D^"_ORDIV_U_ORDEATH_"^DEATH"
 S ORPKG=4 F I="1^OR","2^FH","3^GMRC","4^RA" S ORPKG(+I)=+$O(^DIC(9.4,"C",$P(I,U,2),0))_"^1"
 D PKGS(ORI,.ORPKG),MVTYPES(ORI,"12^38")
 S ^ORD(100.6,ORI,2,0)="^100.61DA^1^1",^(1,0)=ORNOW ;active
 ; ** Create the following but leave inactive for now:
P6 ; -- OR rule
 S ORI=ORI+1,^ORD(100.6,ORI,0)="SURGERY^O^"_ORDIV_U_OROR_"^SURGERY"
 S ORPKG=1,ORPKG(1)=+$O(^DIC(9.4,"C","OR",0))_"^1" D PKGS(ORI,.ORPKG)
 S ^ORD(100.6,ORI,1)=ORNOW
P7 ; -- ON PASS rule
 S ORI=ORI+1,^ORD(100.6,ORI,0)="ON PASS^T^"_ORDIV_U_ORPASS_"^ON PASS"
 D MVTYPES(ORI,"1^2^3") S ^ORD(100.6,ORI,1)=ORNOW
P8 ; -- FROM PASS rule
 S ORI=ORI+1,^ORD(100.6,ORI,0)="FROM PASS^T^"_ORDIV_U_ORPASS_"^FROM PASS"
 D MVTYPES(ORI,"22^23^24^25^26") S ^ORD(100.6,ORI,1)=ORNOW
P9 ; -- TO ASIH rule
 S ORI=ORI+1,^ORD(100.6,ORI,0)="TO ASIH^T^"_ORDIV_U_ORASIH_"^TO ASIH"
 D MVTYPES(ORI,"13") S ^ORD(100.6,ORI,1)=ORNOW
P10 ; -- FROM ASIH rule
 S ORI=ORI+1,^ORD(100.6,ORI,0)="FROM ASIH^T^"_ORDIV_U_ORASIH_"^FROM ASIH"
 D MVTYPES(ORI,"14") S ^ORD(100.6,ORI,1)=ORNOW
 S $P(^ORD(100.6,0),U,3,4)=ORI_U_ORI
 S DIK="^ORD(100.6," D IXALL^DIK ;set xrefs
 ;Set edit history for new rules
 S ORGLOB="^ORD(100.6,"
 S ORI=0 F  S ORI=$O(^ORD(100.6,ORI)) Q:'+ORI  D AUDIT^OREV(ORI,"N")
 Q
 ;
MVTYPES(IEN,TYPES) ; -- save MAS Movement Types
 N CNT,I S CNT=$L(TYPES,U)
 S ^ORD(100.6,IEN,3,0)="^100.63P^"_CNT_U_CNT
 F I=1:1:CNT S ^ORD(100.6,IEN,3,I,0)=+$P(TYPES,U,I)
 Q
 ;
PKGS(IEN,PKGS) ; -- save Included Packages
 N CNT,I S CNT=+$G(PKGS)
 S ^ORD(100.6,IEN,7,0)="^100.67P^"_CNT_U_CNT
 F I=1:1:CNT S ^ORD(100.6,IEN,7,I,0)=+PKGS(I)
 Q