PSJ323PO ;TMC - Patch 323 Post Install routine;9/9/2015
;;5.0;INPATIENT MEDICATIONS;**323**;DEC 1997;Build 10
;
;External reference ^DD(55 supported by DBIA 2191
;
;This post install routine will identify bad "AUD" cross-references and fix them where the date was stored with quotes around them.
;
Q
START ;
N PSJCNT,PSJDFN,PSJSDT,PSJI
S X1=DT,X2=+90 D C^%DTC
S PSJCNT=0
S ^XTMP("PSJ323PO",0)=$G(X)_"^"_DT_"^AUD CROSS REFERENCE DATE FIX^"
S PSJSDT=0 F S PSJSDT=$O(^PS(55,"AUD",PSJSDT)) Q:'PSJSDT I $E(PSJSDT,$L(PSJSDT),$L(PSJSDT))=0 D CHKDT
W !!,"***********PSJ323PO HAS FINISHED*************"
Q
CHKDT ;
S PSJDFN=0 F S PSJDFN=$O(^PS(55,"AUD",PSJSDT,PSJDFN)) Q:PSJDFN="" D
.S PSJI=0 F S PSJI=$O(^PS(55,"AUD",PSJSDT,PSJDFN,PSJI)) Q:PSJI="" D
..S PSJCNT=PSJCNT+1
..S ^XTMP("PSJ323PO",PSJCNT)="^PS(55,""AUD"","_PSJSDT_","_PSJDFN_","_PSJI_")"
..K ^PS(55,"AUD",PSJSDT,PSJDFN,PSJI)
..S ^PS(55,"AUD",+PSJSDT,PSJDFN,PSJI)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJ323PO 971 printed Dec 13, 2024@02:05:52 Page 2
PSJ323PO ;TMC - Patch 323 Post Install routine;9/9/2015
+1 ;;5.0;INPATIENT MEDICATIONS;**323**;DEC 1997;Build 10
+2 ;
+3 ;External reference ^DD(55 supported by DBIA 2191
+4 ;
+5 ;This post install routine will identify bad "AUD" cross-references and fix them where the date was stored with quotes around them.
+6 ;
+7 QUIT
START ;
+1 NEW PSJCNT,PSJDFN,PSJSDT,PSJI
+2 SET X1=DT
SET X2=+90
DO C^%DTC
+3 SET PSJCNT=0
+4 SET ^XTMP("PSJ323PO",0)=$GET(X)_"^"_DT_"^AUD CROSS REFERENCE DATE FIX^"
+5 SET PSJSDT=0
FOR
SET PSJSDT=$ORDER(^PS(55,"AUD",PSJSDT))
if 'PSJSDT
QUIT
IF $EXTRACT(PSJSDT,$LENGTH(PSJSDT),$LENGTH(PSJSDT))=0
DO CHKDT
+6 WRITE !!,"***********PSJ323PO HAS FINISHED*************"
+7 QUIT
CHKDT ;
+1 SET PSJDFN=0
FOR
SET PSJDFN=$ORDER(^PS(55,"AUD",PSJSDT,PSJDFN))
if PSJDFN=""
QUIT
Begin DoDot:1
+2 SET PSJI=0
FOR
SET PSJI=$ORDER(^PS(55,"AUD",PSJSDT,PSJDFN,PSJI))
if PSJI=""
QUIT
Begin DoDot:2
+3 SET PSJCNT=PSJCNT+1
+4 SET ^XTMP("PSJ323PO",PSJCNT)="^PS(55,""AUD"","_PSJSDT_","_PSJDFN_","_PSJI_")"
+5 KILL ^PS(55,"AUD",PSJSDT,PSJDFN,PSJI)
+6 SET ^PS(55,"AUD",+PSJSDT,PSJDFN,PSJI)=""
End DoDot:2
End DoDot:1
+7 QUIT
