ORCPOST ; slc/dcm,MKB - CPRS post-init ;10/25/97 16:13
;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
EN ;-- Post-init cleanup
D POSTORLP^ORLP3C1,POSTORB^ORB3C1 ; User Parameters, Notifications
D BMES^XPDUTL("Cleaning up unused data and fields ...")
K ^ORYX("ORERR") S ^ORYX("ORERR",0)="OE/RR ERRORS^100.4D^^"
D 22,19,101,P49,200,DGPM,ZIS
Q
;
22 ;Set print 0th node
S $P(^ORD(100.22,0),"^",3)=""
;S $P(^ORD(100.23,0),"^",3)=""
D RECMPL^ORPR00
Q
19 ;Clean-up old entry & exit actions in Option file
N IFN,ENT,EX
S IFN=0 F S IFN=$O(^DIC(19,IFN)) Q:IFN<1 S ENT=$G(^(IFN,20)),EX=$G(^(15)) D
. I ENT["D TIT^OR",$P(ENT,"D TIT^",2)="OR" S ^DIC(19,IFN,20)=""
. I ENT["D EN^OR",$P(ENT,"D EN^",2)="OR" S ^DIC(19,IFN,20)="D ^ORCHART"
. I EX="D EXIT^OR" S ^DIC(19,IFN,15)=""
Q
101 ;Clean-up old entry actions in Protocol file
N IFN,ENT
S IFN=0 F S IFN=$O(^ORD(101,IFN)) Q:IFN<1 S ENT=$G(^(IFN,20)) D
. I ENT["^OR3" S ^ORD(101,IFN,20)="" Q
Q
200 ;Clean-up unused data and fields in file 200
N DA,DIK,IFN
S IFN=0 F S IFN=$O(^VA(200,IFN)) Q:IFN<1 D
. I $D(^VA(200,IFN,100.1)) K ^(100.1)
. I $D(^VA(200,IFN,100.2)) K ^(100.2)
S DIK="^DD(200,",DA=100.21,DA(1)=200 D ^DIK ;Remove Summary Default
S DIK="^DD(200,",DA=100.22,DA(1)=200 D ^DIK ;Remove Patient List Order
S DIK="^DD(200,",DA=100.23,DA(1)=200 D ^DIK ;Remove Default Result Reporting
S DIK="^DD(200,",DA=100.24,DA(1)=200 D ^DIK ;Remove Primary Profile Menu
S DIK="^DD(200,",DA=100.25,DA(1)=200 D ^DIK ;Remove Provider List
S DIK="^DD(200,",DA=100.26,DA(1)=200 D ^DIK ;Remove Specialty List
S DIK="^DD(200,",DA=100.27,DA(1)=200 D ^DIK ;Remove New Orders Default
S DIK="^DD(200,",DA=100.11,DA(1)=200 D ^DIK ;Remove Primary OE/RR Menu
S DIK="^DD(200,",DA=100.12,DA(1)=200 D ^DIK ;Remove Primary Order Menu
S DIK="^DD(200,",DA=100.13,DA(1)=200 D ^DIK ;Remove Primary Order Display
S DIK="^DD(200,",DA=100.14,DA(1)=200 D ^DIK ;Remove Ward List
S DIK="^DD(200,",DA=100.15,DA(1)=200 D ^DIK ;Remove Patient List
S DIK="^DD(200,",DA=100.16,DA(1)=200 D ^DIK ;Remove Selectpat
S DIK="^DD(200,",DA=100.17,DA(1)=200 D ^DIK ;Remove Clinic List
S DIK="^DD(200,",DA=100.18,DA(1)=200 D ^DIK ;Remove Clinic Appointment Start
S DIK="^DD(200,",DA=100.19,DA(1)=200 D ^DIK ;Remove Clinic Appointment Stop
Q
;
DGPM ; -- Replace OR items on DGPM MOVEMENT EVENTS
N DGPM,DIK,DA,DIC,DLAYGO,X,Y,ORDITEM,ORTASK,ORNOTASK,ORD,DONE
S DGPM=+$O(^ORD(101,"B","DGPM MOVEMENT EVENTS",0)) Q:'DGPM
F X=""," NOTASK" S Y=+$O(^ORD(101,"B","OR GUA EVENT PROCESSOR"_X,0)) I Y,$O(^ORD(101,"AD",Y,DGPM,0)) S DONE=1 Q ; already added
Q:$G(DONE) S DA(1)=DGPM,DIK="^ORD(101,"_DGPM_",10,"
F ORDITEM="GENERIC ORDERS","GEN ORD ON TRANS" D
. S ORD=$O(^ORD(101,"B","OR GUA DC "_ORDITEM,0)) Q:'ORD
. S DA=$O(^ORD(101,"AD",ORD,DGPM,0)) I DA D ^DIK S ORTASK=1
. S ORD=$O(^ORD(101,"B","OR GUA DC "_ORDITEM_" NOTASK",0)) Q:'ORD
. S DA=$O(^ORD(101,"AD",ORD,DGPM,0)) I DA D ^DIK S ORNOTASK=1
S DIC=DIK,DIC(0)="L",DLAYGO=101,DIC("P")=$P(^DD(101,10,0),U,2),DIC("DR")="3///999",X=+$O(^ORD(101,"B","OR GUA EVENT PROCESSOR"_$S($G(ORNOTASK):" NOTASK",1:""),0)) K Y
D:X FILE^DICN I +$G(Y)'>0 D BMES^XPDUTL(">>> Unable to add OR GUA EVENT PROCESSOR protocol to DGPM MOVEMENT EVENTS")
Q
;
P49 ; -- Ck stuff in patch 49 (do, if clean install)
I $O(^ORD(101.43,0)) D OI^ORSETUP1 ; Ck quick order ptrs only
I '$O(^ORD(101.43,0)) D ORDITMS^ORSETUP ; or populate whole file
D BMES^XPDUTL("Populating Parameters file ..."),^ORXPAR
I '$P($G(^ORD(100.99,1,200)),U,2) D ; [re]convert patch 49 stuff
. D ^ORPFCNVT,PARM^RAO7MFN ; Update package parameters
. D DGROUPS^ORSETUP ; Add new fields to #100.98
. D URG^ORSETUP ; Add Consult urgencies
. K ^ORD(100.99,1,101),^(101.41),^(200) D DIALOGS^ORSETUP ; #101->101.41
S $P(^ORD(100.99,1,200),U,2)=1 ; Done.
Q
;
ZIS ; -- Add OR WORKSTATION and resource devices
N DA,DIC,DIE,DLAYGO,X,Y
S DIC(0)="LQMZ",(DIC,DLAYGO)=3.5,X="OR WORKSTATION" D ^DIC
I Y,$P(Y,"^",3) D ; if newly added
. S DA=+Y,DIE=DIC
. S DR=".02///^S X=""OR Workstation HFS Device"";1///^S X=""ORDEV.DAT"""
. S DR=DR_";1.95////0;2///^S X=""HFS"";4////0;5////0;5.1////0;5.2////0"
. S DR=DR_";3///^S X=""`""_"_$$SUBTYPE^ORCPOST()
. D ^DIE
;
S X=$$RES^XUDHSET("ORW/PXAPI RESOURCE",,5,"CPRS to PCE transactions")
S X=$$RES^XUDHSET("ORB NOTIFICATION RESOURCE",,5,"OE/RR notifications")
S X=$$RES^XUDHSET("OR MOVEMENT RESOURCE",,5,"OR movement event process")
Q
;
SUBTYPE() ; get subtype for P-OTHER
N DIC,X
S DIC(0)="QMXZ",DIC="^%ZIS(2,",X="P-OTHER" D ^DIC
Q +Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCPOST 4687 printed Dec 13, 2024@02:28:54 Page 2
ORCPOST ; slc/dcm,MKB - CPRS post-init ;10/25/97 16:13
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
EN ;-- Post-init cleanup
+1 ; User Parameters, Notifications
DO POSTORLP^ORLP3C1
DO POSTORB^ORB3C1
+2 DO BMES^XPDUTL("Cleaning up unused data and fields ...")
+3 KILL ^ORYX("ORERR")
SET ^ORYX("ORERR",0)="OE/RR ERRORS^100.4D^^"
+4 DO 22
DO 19
DO 101
DO P49
DO 200
DO DGPM
DO ZIS
+5 QUIT
+6 ;
22 ;Set print 0th node
+1 SET $PIECE(^ORD(100.22,0),"^",3)=""
+2 ;S $P(^ORD(100.23,0),"^",3)=""
+3 DO RECMPL^ORPR00
+4 QUIT
19 ;Clean-up old entry & exit actions in Option file
+1 NEW IFN,ENT,EX
+2 SET IFN=0
FOR
SET IFN=$ORDER(^DIC(19,IFN))
if IFN<1
QUIT
SET ENT=$GET(^(IFN,20))
SET EX=$GET(^(15))
Begin DoDot:1
+3 IF ENT["D TIT^OR"
IF $PIECE(ENT,"D TIT^",2)="OR"
SET ^DIC(19,IFN,20)=""
+4 IF ENT["D EN^OR"
IF $PIECE(ENT,"D EN^",2)="OR"
SET ^DIC(19,IFN,20)="D ^ORCHART"
+5 IF EX="D EXIT^OR"
SET ^DIC(19,IFN,15)=""
End DoDot:1
+6 QUIT
101 ;Clean-up old entry actions in Protocol file
+1 NEW IFN,ENT
+2 SET IFN=0
FOR
SET IFN=$ORDER(^ORD(101,IFN))
if IFN<1
QUIT
SET ENT=$GET(^(IFN,20))
Begin DoDot:1
+3 IF ENT["^OR3"
SET ^ORD(101,IFN,20)=""
QUIT
End DoDot:1
+4 QUIT
200 ;Clean-up unused data and fields in file 200
+1 NEW DA,DIK,IFN
+2 SET IFN=0
FOR
SET IFN=$ORDER(^VA(200,IFN))
if IFN<1
QUIT
Begin DoDot:1
+3 IF $DATA(^VA(200,IFN,100.1))
KILL ^(100.1)
+4 IF $DATA(^VA(200,IFN,100.2))
KILL ^(100.2)
End DoDot:1
+5 ;Remove Summary Default
SET DIK="^DD(200,"
SET DA=100.21
SET DA(1)=200
DO ^DIK
+6 ;Remove Patient List Order
SET DIK="^DD(200,"
SET DA=100.22
SET DA(1)=200
DO ^DIK
+7 ;Remove Default Result Reporting
SET DIK="^DD(200,"
SET DA=100.23
SET DA(1)=200
DO ^DIK
+8 ;Remove Primary Profile Menu
SET DIK="^DD(200,"
SET DA=100.24
SET DA(1)=200
DO ^DIK
+9 ;Remove Provider List
SET DIK="^DD(200,"
SET DA=100.25
SET DA(1)=200
DO ^DIK
+10 ;Remove Specialty List
SET DIK="^DD(200,"
SET DA=100.26
SET DA(1)=200
DO ^DIK
+11 ;Remove New Orders Default
SET DIK="^DD(200,"
SET DA=100.27
SET DA(1)=200
DO ^DIK
+12 ;Remove Primary OE/RR Menu
SET DIK="^DD(200,"
SET DA=100.11
SET DA(1)=200
DO ^DIK
+13 ;Remove Primary Order Menu
SET DIK="^DD(200,"
SET DA=100.12
SET DA(1)=200
DO ^DIK
+14 ;Remove Primary Order Display
SET DIK="^DD(200,"
SET DA=100.13
SET DA(1)=200
DO ^DIK
+15 ;Remove Ward List
SET DIK="^DD(200,"
SET DA=100.14
SET DA(1)=200
DO ^DIK
+16 ;Remove Patient List
SET DIK="^DD(200,"
SET DA=100.15
SET DA(1)=200
DO ^DIK
+17 ;Remove Selectpat
SET DIK="^DD(200,"
SET DA=100.16
SET DA(1)=200
DO ^DIK
+18 ;Remove Clinic List
SET DIK="^DD(200,"
SET DA=100.17
SET DA(1)=200
DO ^DIK
+19 ;Remove Clinic Appointment Start
SET DIK="^DD(200,"
SET DA=100.18
SET DA(1)=200
DO ^DIK
+20 ;Remove Clinic Appointment Stop
SET DIK="^DD(200,"
SET DA=100.19
SET DA(1)=200
DO ^DIK
+21 QUIT
+22 ;
DGPM ; -- Replace OR items on DGPM MOVEMENT EVENTS
+1 NEW DGPM,DIK,DA,DIC,DLAYGO,X,Y,ORDITEM,ORTASK,ORNOTASK,ORD,DONE
+2 SET DGPM=+$ORDER(^ORD(101,"B","DGPM MOVEMENT EVENTS",0))
if 'DGPM
QUIT
+3 ; already added
FOR X=""," NOTASK"
SET Y=+$ORDER(^ORD(101,"B","OR GUA EVENT PROCESSOR"_X,0))
IF Y
IF $ORDER(^ORD(101,"AD",Y,DGPM,0))
SET DONE=1
QUIT
+4 if $GET(DONE)
QUIT
SET DA(1)=DGPM
SET DIK="^ORD(101,"_DGPM_",10,"
+5 FOR ORDITEM="GENERIC ORDERS","GEN ORD ON TRANS"
Begin DoDot:1
+6 SET ORD=$ORDER(^ORD(101,"B","OR GUA DC "_ORDITEM,0))
if 'ORD
QUIT
+7 SET DA=$ORDER(^ORD(101,"AD",ORD,DGPM,0))
IF DA
DO ^DIK
SET ORTASK=1
+8 SET ORD=$ORDER(^ORD(101,"B","OR GUA DC "_ORDITEM_" NOTASK",0))
if 'ORD
QUIT
+9 SET DA=$ORDER(^ORD(101,"AD",ORD,DGPM,0))
IF DA
DO ^DIK
SET ORNOTASK=1
End DoDot:1
+10 SET DIC=DIK
SET DIC(0)="L"
SET DLAYGO=101
SET DIC("P")=$PIECE(^DD(101,10,0),U,2)
SET DIC("DR")="3///999"
SET X=+$ORDER(^ORD(101,"B","OR GUA EVENT PROCESSOR"_$SELECT($GET(ORNOTASK):" NOTASK",1:""),0))
KILL Y
+11 if X
DO FILE^DICN
IF +$GET(Y)'>0
DO BMES^XPDUTL(">>> Unable to add OR GUA EVENT PROCESSOR protocol to DGPM MOVEMENT EVENTS")
+12 QUIT
+13 ;
P49 ; -- Ck stuff in patch 49 (do, if clean install)
+1 ; Ck quick order ptrs only
IF $ORDER(^ORD(101.43,0))
DO OI^ORSETUP1
+2 ; or populate whole file
IF '$ORDER(^ORD(101.43,0))
DO ORDITMS^ORSETUP
+3 DO BMES^XPDUTL("Populating Parameters file ...")
DO ^ORXPAR
+4 ; [re]convert patch 49 stuff
IF '$PIECE($GET(^ORD(100.99,1,200)),U,2)
Begin DoDot:1
+5 ; Update package parameters
DO ^ORPFCNVT
DO PARM^RAO7MFN
+6 ; Add new fields to #100.98
DO DGROUPS^ORSETUP
+7 ; Add Consult urgencies
DO URG^ORSETUP
+8 ; #101->101.41
KILL ^ORD(100.99,1,101),^(101.41),^(200)
DO DIALOGS^ORSETUP
End DoDot:1
+9 ; Done.
SET $PIECE(^ORD(100.99,1,200),U,2)=1
+10 QUIT
+11 ;
ZIS ; -- Add OR WORKSTATION and resource devices
+1 NEW DA,DIC,DIE,DLAYGO,X,Y
+2 SET DIC(0)="LQMZ"
SET (DIC,DLAYGO)=3.5
SET X="OR WORKSTATION"
DO ^DIC
+3 ; if newly added
IF Y
IF $PIECE(Y,"^",3)
Begin DoDot:1
+4 SET DA=+Y
SET DIE=DIC
+5 SET DR=".02///^S X=""OR Workstation HFS Device"";1///^S X=""ORDEV.DAT"""
+6 SET DR=DR_";1.95////0;2///^S X=""HFS"";4////0;5////0;5.1////0;5.2////0"
+7 SET DR=DR_";3///^S X=""`""_"_$$SUBTYPE^ORCPOST()
+8 DO ^DIE
End DoDot:1
+9 ;
+10 SET X=$$RES^XUDHSET("ORW/PXAPI RESOURCE",,5,"CPRS to PCE transactions")
+11 SET X=$$RES^XUDHSET("ORB NOTIFICATION RESOURCE",,5,"OE/RR notifications")
+12 SET X=$$RES^XUDHSET("OR MOVEMENT RESOURCE",,5,"OR movement event process")
+13 QUIT
+14 ;
SUBTYPE() ; get subtype for P-OTHER
+1 NEW DIC,X
+2 SET DIC(0)="QMXZ"
SET DIC="^%ZIS(2,"
SET X="P-OTHER"
DO ^DIC
+3 QUIT +Y
