PSDRF2.m

PSDRF2 ;BIR/JPW,LTL-Nurse RF Dispensing count correction; 8 Aug 94

 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

QTY S DIR(0)="NA^.01:999999:2",DIR("A")="Correct Count: "

 W ! D ^DIR K DIR

 I $D(DIRUT)!(Y'>0) S PSDOUT=1 G END

 S PSDQ(1)=Y,PSDTYP=9,PSDQ=OQTY-Y

 I PSDQ(1)=OQTY W !!,"That's no change." Q

 I Y>OQTY S NAOU(1)=0 D ^PSDORSU G:$G(NAOU(1)) BAL^PSDRF I $G(PSDOUT) G END

 S DIR(0)="58.81,15" W ! D ^DIR K DIR

 I $D(DIRUT) S PSDOUT=1 G END

 S PSDRE=Y

WIT W ! S NUR2=$$WITNESS^XUVERIFY("WITNESS")

 I DUZ=NUR2 W !!,"Hold it, you can't witness yourself!",$C(7) G WIT

 I NUR2'>0 S PSDOUT=1 Q

 W !!,"Thank you, ",$S($P($G(^VA(200,NUR2,.1)),U,4)]"":$P($G(^(.1)),U,4),1:$P($G(^VA(200,NUR2,0)),U))

 D UPDAT^PSDRF1

END K %,%DT,%H,%I,CNT,CNT1,DA,DIC,DIE,DINUM,DIR,DIROUT,DIRUT,DIWF,DIWL,DIWR,DR,DTOUT,DUOUT,LN,MSG,MSG1

 K NAOUN,NBKU,NPKG,OK,OKTYP,ORD,PSDA,PSDEM,PSDQTY,PSDRD,PSDRE,PSDRN,PSDT,PSDUZ,PSDUZN,REQD,TEXT,TYPE,WORD,X

 Q

PSDRF2    ;BIR/JPW,LTL-Nurse RF Dispensing count correction; 8 Aug 94

 +1       ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

QTY        SET DIR(0)="NA^.01:999999:2"

           SET DIR("A")="Correct Count: "

 +1        WRITE !

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)!(Y'>0)

               SET PSDOUT=1

               GOTO END

 +3        SET PSDQ(1)=Y

           SET PSDTYP=9

           SET PSDQ=OQTY-Y

 +4        IF PSDQ(1)=OQTY

               WRITE !!,"That's no change."

               QUIT 

 +5        IF Y>OQTY

               SET NAOU(1)=0

               DO ^PSDORSU

               IF $GET(NAOU(1))

                   GOTO BAL^PSDRF

               IF $GET(PSDOUT)

                   GOTO END

 +6        SET DIR(0)="58.81,15"

           WRITE !

           DO ^DIR

           KILL DIR

 +7        IF $DATA(DIRUT)

               SET PSDOUT=1

               GOTO END

 +8        SET PSDRE=Y

WIT        WRITE !

           SET NUR2=$$WITNESS^XUVERIFY("WITNESS")

 +1        IF DUZ=NUR2

               WRITE !!,"Hold it, you can't witness yourself!",$CHAR(7)

               GOTO WIT

 +2        IF NUR2'>0

               SET PSDOUT=1

               QUIT 

 +3        WRITE !!,"Thank you, ",$SELECT($PIECE($GET(^VA(200,NUR2,.1)),U,4)]"":$PIECE($GET(^(.1)),U,4),1:$PIECE($GET(^VA(200,NUR2,0)),U))

 +4        DO UPDAT^PSDRF1

END        KILL %,%DT,%H,%I,CNT,CNT1,DA,DIC,DIE,DINUM,DIR,DIROUT,DIRUT,DIWF,DIWL,DIWR,DR,DTOUT,DUOUT,LN,MSG,MSG1

 +1        KILL NAOUN,NBKU,NPKG,OK,OKTYP,ORD,PSDA,PSDEM,PSDQTY,PSDRD,PSDRE,PSDRN,PSDT,PSDUZ,PSDUZN,REQD,TEXT,TYPE,WORD,X

 +2        QUIT