- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDRF2 942 printed Jan 18, 2025@02:49:48 Page 2
- 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