PSO227PO ;BIR/SJA-Patch 227 Post Install routine ;11/25/05
;;7.0;OUTPATIENT PHARMACY;**227**;DEC 1997
;
; Reference to ^ORD(101 is supported by DBIA #872
; External reference to file 870 is supported by DBIA #1496
;
N CNT,PSOA,PSODT,PSONODE,PSORESN,PSOPRTCL,PSOPRT,SDPRTCL
;Set AUTOSTART to Disabled for PSOTPBAAC Logical Link
N DIE,DR,DIC,DA,X,Y
K DIC S DIC(0)="X",DIC=870,X="PSOTPBAAC" D ^DIC K DIC
I +Y>0 K DIE S DA=+Y,DIE=870,DR="4.5////"_0 D ^DIE K DA,DR,DIE
;
D RESCH^XUTMOPT("PSO TPB HL7 EXTRACT","@","","@")
OUT D BMES^XPDUTL("...Placing TPB menu options out of order...")
;Disable TPB menu options
S PSORESN="PLACED OUT OF ORDER BY PSO*7*227"
D OUT^XPDMENU("PSO TPB HL7 EXTRACT",PSORESN)
D OUT^XPDMENU("PSO TPB INSTITUTION LETTERS",PSORESN)
D OUT^XPDMENU("PSO TPB LETTERS PRINTED REPORT",PSORESN)
D OUT^XPDMENU("PSO TPB PATIENT ENTER/EDIT",PSORESN)
D OUT^XPDMENU("PSO TPB PATIENT REPORT",PSORESN)
D OUT^XPDMENU("PSO TPB PATIENT RX REPORT",PSORESN)
D OUT^XPDMENU("PSO TPB PRINT LETTERS",PSORESN)
D OUT^XPDMENU("PSO TPB RX ENTRY",PSORESN)
;
IACT D BMES^XPDUTL("...Inactivating all active TPB patients...")
D NOW^%DTC S PSODT=$P(%,".")
S (PSOA,CNT)=0 F S PSOA=$O(^PS(52.91,PSOA)) Q:'PSOA S PSONODE=$G(^(PSOA,0)) I '$P(PSONODE,"^",3)!($P(PSONODE,"^",3)>PSODT) D
.S DA=PSOA,DIE="^PS(52.91,",DR="2///"_PSODT_";3///10" D ^DIE K DIE,DA,DR
.S CNT=CNT+1 W:'(CNT#10) "."
;
PRTCL ;Unsubscribe the Pharmacy PSO TPB SD SUB protocol from the Scheduling protocol SDAM APPOINTMENT EVENTS
S SDPRTCL=$O(^ORD(101,"B","SDAM APPOINTMENT EVENTS",0))
S PSOPRTCL=$O(^ORD(101,"B","PSO TPB SD SUB",0))
I 'SDPRTCL!'PSOPRTCL Q
S PSOPRT=$O(^ORD(101,SDPRTCL,10,"B",PSOPRTCL,0)) I 'PSOPRT Q
K DA,DIK S DA=PSOPRT,DA(1)=SDPRTCL,DIK="^ORD(101,"_DA(1)_",10," D ^DIK K DA,DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO227PO 1825 printed Nov 22, 2024@17:32:41 Page 2
PSO227PO ;BIR/SJA-Patch 227 Post Install routine ;11/25/05
+1 ;;7.0;OUTPATIENT PHARMACY;**227**;DEC 1997
+2 ;
+3 ; Reference to ^ORD(101 is supported by DBIA #872
+4 ; External reference to file 870 is supported by DBIA #1496
+5 ;
+6 NEW CNT,PSOA,PSODT,PSONODE,PSORESN,PSOPRTCL,PSOPRT,SDPRTCL
+7 ;Set AUTOSTART to Disabled for PSOTPBAAC Logical Link
+8 NEW DIE,DR,DIC,DA,X,Y
+9 KILL DIC
SET DIC(0)="X"
SET DIC=870
SET X="PSOTPBAAC"
DO ^DIC
KILL DIC
+10 IF +Y>0
KILL DIE
SET DA=+Y
SET DIE=870
SET DR="4.5////"_0
DO ^DIE
KILL DA,DR,DIE
+11 ;
+12 DO RESCH^XUTMOPT("PSO TPB HL7 EXTRACT","@","","@")
OUT DO BMES^XPDUTL("...Placing TPB menu options out of order...")
+1 ;Disable TPB menu options
+2 SET PSORESN="PLACED OUT OF ORDER BY PSO*7*227"
+3 DO OUT^XPDMENU("PSO TPB HL7 EXTRACT",PSORESN)
+4 DO OUT^XPDMENU("PSO TPB INSTITUTION LETTERS",PSORESN)
+5 DO OUT^XPDMENU("PSO TPB LETTERS PRINTED REPORT",PSORESN)
+6 DO OUT^XPDMENU("PSO TPB PATIENT ENTER/EDIT",PSORESN)
+7 DO OUT^XPDMENU("PSO TPB PATIENT REPORT",PSORESN)
+8 DO OUT^XPDMENU("PSO TPB PATIENT RX REPORT",PSORESN)
+9 DO OUT^XPDMENU("PSO TPB PRINT LETTERS",PSORESN)
+10 DO OUT^XPDMENU("PSO TPB RX ENTRY",PSORESN)
+11 ;
IACT DO BMES^XPDUTL("...Inactivating all active TPB patients...")
+1 DO NOW^%DTC
SET PSODT=$PIECE(%,".")
+2 SET (PSOA,CNT)=0
FOR
SET PSOA=$ORDER(^PS(52.91,PSOA))
if 'PSOA
QUIT
SET PSONODE=$GET(^(PSOA,0))
IF '$PIECE(PSONODE,"^",3)!($PIECE(PSONODE,"^",3)>PSODT)
Begin DoDot:1
+3 SET DA=PSOA
SET DIE="^PS(52.91,"
SET DR="2///"_PSODT_";3///10"
DO ^DIE
KILL DIE,DA,DR
+4 SET CNT=CNT+1
if '(CNT#10)
WRITE "."
End DoDot:1
+5 ;
PRTCL ;Unsubscribe the Pharmacy PSO TPB SD SUB protocol from the Scheduling protocol SDAM APPOINTMENT EVENTS
+1 SET SDPRTCL=$ORDER(^ORD(101,"B","SDAM APPOINTMENT EVENTS",0))
+2 SET PSOPRTCL=$ORDER(^ORD(101,"B","PSO TPB SD SUB",0))
+3 IF 'SDPRTCL!'PSOPRTCL
QUIT
+4 SET PSOPRT=$ORDER(^ORD(101,SDPRTCL,10,"B",PSOPRTCL,0))
IF 'PSOPRT
QUIT
+5 KILL DA,DIK
SET DA=PSOPRT
SET DA(1)=SDPRTCL
SET DIK="^ORD(101,"_DA(1)_",10,"
DO ^DIK
KILL DA,DIK
+6 QUIT
