Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORY142

ORY142.m

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