PSDCOR3.m

PSDCOR3 ;BIR/JPW-CS Correction Action (cont'd) ; 22 May 93

 ;;3.0; CONTROLLED SUBSTANCES ;**66**;13 Feb 97;Build 3

COM ;complete correction

 S CPBYD=+$P(NODE,"^",19)

 F  L +^PSD(58.87,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I  Q

FIND S PSDCOR=$P(^PSD(58.87,0),"^",3)+1 I $D(^PSD(58.87,PSDCOR)) S $P(^PSD(58.87,0),"^",3)=PSDCOR G FIND

 K DA,DIC,DLAYGO S (DIC,DLAYGO)=58.87,DIC(0)="L",X=PSDCOR D ^DIC K DIC,DLAYGO

 L -^PSD(58.87,0)

 K DA,DIE,DR S DIE=58.87,DA=PSDCOR,DR="1////"_RECDT_";2////"_PSDUZ_";3////"_PSDPN_";4////"_PSDR_";5////"_NAOU_";7////"_CPBYD_";8////"_ORD_";9////"_CPBY_";11////"_TYPE_";12////"_PSDS_";13////"_OCOMP_";14////"_COMP

 D ^DIE K DA,DIE,DR

END K CPBY,CPBYD,PSDCOR

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSDCOR3   697     printed  Apr 09, 2024@20:54:25                                                                                                                                                                                                      Page 2

PSDCOR3   ;BIR/JPW-CS Correction Action (cont'd) ; 22 May 93

 +1       ;;3.0; CONTROLLED SUBSTANCES ;**66**;13 Feb 97;Build 3

COM       ;complete correction

 +1        SET CPBYD=+$PIECE(NODE,"^",19)

 +2        FOR 

               LOCK +^PSD(58.87,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)

              IF $TEST

                   QUIT 

FIND       SET PSDCOR=$PIECE(^PSD(58.87,0),"^",3)+1

           IF $DATA(^PSD(58.87,PSDCOR))

               SET $PIECE(^PSD(58.87,0),"^",3)=PSDCOR

               GOTO FIND

 +1        KILL DA,DIC,DLAYGO

           SET (DIC,DLAYGO)=58.87

           SET DIC(0)="L"

           SET X=PSDCOR

           DO ^DIC

           KILL DIC,DLAYGO

 +2        LOCK -^PSD(58.87,0)

 +3        KILL DA,DIE,DR

           SET DIE=58.87

           SET DA=PSDCOR

           SET DR="1////"_RECDT_";2////"_PSDUZ_";3////"_PSDPN_";4////"_PSDR_";5////"_NAOU_";7////"_CPBYD_";8////"_ORD_";9////"_CPBY_";11////"_TYPE_";12////"_PSDS_";13////"_OCOMP_";14////"_COMP

 +4        DO ^DIE

           KILL DA,DIE,DR

END        KILL CPBY,CPBYD,PSDCOR

 +1        QUIT