Routine: PSJ323PO

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.

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*************"

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)=""

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJ323PO   971     printed  Feb 18, 2025@23:32:15                                                                                                                                                                                                     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

PSJ323PO.m