ORCPOST.m

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 ---ORCPOST   4687     printed  Mar 13, 2025@21:33:51                                                                                                                                                                                                     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