- PSDERD ;BIR/JPW-CS Error Log Edit ; 20 Aug 94
- ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)
- S OK=$S($D(^XUSEC("PSDMGR",DUZ)):1,$D(^XUSEC("PSD ERROR",DUZ)):2,1:0)
- I 'OK W $C(7),!!,?9,"** Please contact your Pharmacy Coordinator for access to",!,?12,"the pending Controlled Substances error log.",!!,"PSDMGR or PSD ERROR security key required.",! K OK Q
- S PSDUZ=DUZ
- K LN S $P(LN,"-",30)=""
- S PSDS=$P(PSDSITE,U,3),PSDSN=$P(PSDSITE,U,4) G:$P(PSDSITE,U,5) EDIT
- ASKD ;ask disp location
- W !!!,"You may select a Dispensing Site at the prompt.",!
- W ! K DIC,DA S DIC=58.8,DIC(0)="QEAZ"
- S DIC("S")="I $P(^(0),""^"",3)=+PSDSITE,$S($P(^(0),""^"",2)[""M"":1,$P(^(0),""^"",2)[""S"":1,1:0)"
- S DIC("A")="Select Dispensing Site: ",DIC("B")=PSDSN
- D ^DIC K DIC G:Y<0 END
- S PSDS=+Y,PSDSN=$P(Y,"^",2),$P(PSDSITE,U,3)=+Y,$P(PSDSITE,U,4)=PSDSN
- EDIT ;edit entry
- K DA,DIC S DIC=58.89,DIC("S")="I $P(^(0),""^"",6)=PSDS",DIC("A")="Select Error Log Number: ",DIC(0)="QEAZ"
- D ^DIC K DIC G:Y<0 END S PSD=+Y,NODE=Y(0)
- S PSDA=+$P(NODE,"^",2),PSDATE=$P(NODE,"^",3) I PSDATE S Y=PSDATE X ^DD("DD") S PSDATE=Y
- ;transaction to edit
- I '$D(^PSD(58.81,PSDA,0)) W !!,"Transaction unavailable for editing.",!! G END
- W !!,"Accessing transaction now..."
- S NODE1=^PSD(58.81,PSDA,0),NODE9=$G(^PSD(58.81,PSDA,9))
- S PSDR=+$P(NODE1,"^",5),PSDRN=$P($G(^PSDRUG(PSDR,0)),"^"),PSDQTY=+$P(NODE1,"^",6)
- S PSDTYP=+$P(NODE1,"^",2),PSDTYP=$P($G(^PSD(58.84,PSDTYP,0)),"^")
- S PSD1=$S(+$P(NODE9,"^",2):+$P(NODE9,"^",2),+$P(NODE9,"^",8):+$P(NODE9,"^",8),+$P(NODE9,"^",11):+$P(NODE9,"^",11),1:"UNKNOWN")
- S:PSD1 PSD1=$P($G(^VA(200,PSD1,0)),"^")
- S PSD2=$S(+$P(NODE9,"^",6):+$P(NODE9,"^",6),+$P(NODE9,"^",9):+$P(NODE9,"^",9),+$P(NODE9,"^",12):+$P(NODE9,"^",12),1:"")
- S:PSD2 PSD2=$P($G(^VA(200,PSD2,0)),"^")
- D DISPLAY
- DIE ;
- D NOW^%DTC S PSDT=+$E(%,1,12)
- W !!,"Enter your resolution.",!
- K DA,DIE,DR S DIE=58.89,DA=PSD,DR="5;4////"_PSDT_";3////"_PSDUZ D ^DIE K DA,DIE,DR
- END ;
- K %,%DT,%H,%I,%ZIS,ALL,CNT,DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LN,NODE,NODE1,NODE9
- K PG,PHARM,PHARMN,POP,PSD,PSD1,PSD2,PSDA,PSDATE,PSDED,PSDEV,PSDN,PSDOUT,PSDQTY,PSDR,PSDRG,PSDRN,PSDS,PSDSD,PSDSN,PSDT,PSDTYP,PSDUZ
- K QTY,RPDT,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
- Q
- DISPLAY ;display info
- W !!,"Transaction Information",!,LN,!
- W !,PSDRN,!,"Transaction Type: ",PSDTYP,!,"Date Entered: ",PSDATE,?50,"Quantity: ",PSDQTY,!,"Entered By: ",PSD1,! W:PSD2]"" "Witnessed By: ",PSD2,!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDERD 2501 printed Mar 13, 2025@20:50:29 Page 2
- PSDERD ;BIR/JPW-CS Error Log Edit ; 20 Aug 94
- +1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- +2 IF '$DATA(PSDSITE)
- DO ^PSDSET
- if '$DATA(PSDSITE)
- QUIT
- +3 SET OK=$SELECT($DATA(^XUSEC("PSDMGR",DUZ)):1,$DATA(^XUSEC("PSD ERROR",DUZ)):2,1:0)
- +4 IF 'OK
- WRITE $CHAR(7),!!,?9,"** Please contact your Pharmacy Coordinator for access to",!,?12,"the pending Controlled Substances error log.",!!,"PSDMGR or PSD ERROR security key required.",!
- KILL OK
- QUIT
- +5 SET PSDUZ=DUZ
- +6 KILL LN
- SET $PIECE(LN,"-",30)=""
- +7 SET PSDS=$PIECE(PSDSITE,U,3)
- SET PSDSN=$PIECE(PSDSITE,U,4)
- if $PIECE(PSDSITE,U,5)
- GOTO EDIT
- ASKD ;ask disp location
- +1 WRITE !!!,"You may select a Dispensing Site at the prompt.",!
- +2 WRITE !
- KILL DIC,DA
- SET DIC=58.8
- SET DIC(0)="QEAZ"
- +3 SET DIC("S")="I $P(^(0),""^"",3)=+PSDSITE,$S($P(^(0),""^"",2)[""M"":1,$P(^(0),""^"",2)[""S"":1,1:0)"
- +4 SET DIC("A")="Select Dispensing Site: "
- SET DIC("B")=PSDSN
- +5 DO ^DIC
- KILL DIC
- if Y<0
- GOTO END
- +6 SET PSDS=+Y
- SET PSDSN=$PIECE(Y,"^",2)
- SET $PIECE(PSDSITE,U,3)=+Y
- SET $PIECE(PSDSITE,U,4)=PSDSN
- EDIT ;edit entry
- +1 KILL DA,DIC
- SET DIC=58.89
- SET DIC("S")="I $P(^(0),""^"",6)=PSDS"
- SET DIC("A")="Select Error Log Number: "
- SET DIC(0)="QEAZ"
- +2 DO ^DIC
- KILL DIC
- if Y<0
- GOTO END
- SET PSD=+Y
- SET NODE=Y(0)
- +3 SET PSDA=+$PIECE(NODE,"^",2)
- SET PSDATE=$PIECE(NODE,"^",3)
- IF PSDATE
- SET Y=PSDATE
- XECUTE ^DD("DD")
- SET PSDATE=Y
- +4 ;transaction to edit
- +5 IF '$DATA(^PSD(58.81,PSDA,0))
- WRITE !!,"Transaction unavailable for editing.",!!
- GOTO END
- +6 WRITE !!,"Accessing transaction now..."
- +7 SET NODE1=^PSD(58.81,PSDA,0)
- SET NODE9=$GET(^PSD(58.81,PSDA,9))
- +8 SET PSDR=+$PIECE(NODE1,"^",5)
- SET PSDRN=$PIECE($GET(^PSDRUG(PSDR,0)),"^")
- SET PSDQTY=+$PIECE(NODE1,"^",6)
- +9 SET PSDTYP=+$PIECE(NODE1,"^",2)
- SET PSDTYP=$PIECE($GET(^PSD(58.84,PSDTYP,0)),"^")
- +10 SET PSD1=$SELECT(+$PIECE(NODE9,"^",2):+$PIECE(NODE9,"^",2),+$PIECE(NODE9,"^",8):+$PIECE(NODE9,"^",8),+$PIECE(NODE9,"^",11):+$PIECE(NODE9,"^",11),1:"UNKNOWN")
- +11 if PSD1
- SET PSD1=$PIECE($GET(^VA(200,PSD1,0)),"^")
- +12 SET PSD2=$SELECT(+$PIECE(NODE9,"^",6):+$PIECE(NODE9,"^",6),+$PIECE(NODE9,"^",9):+$PIECE(NODE9,"^",9),+$PIECE(NODE9,"^",12):+$PIECE(NODE9,"^",12),1:"")
- +13 if PSD2
- SET PSD2=$PIECE($GET(^VA(200,PSD2,0)),"^")
- +14 DO DISPLAY
- DIE ;
- +1 DO NOW^%DTC
- SET PSDT=+$EXTRACT(%,1,12)
- +2 WRITE !!,"Enter your resolution.",!
- +3 KILL DA,DIE,DR
- SET DIE=58.89
- SET DA=PSD
- SET DR="5;4////"_PSDT_";3////"_PSDUZ
- DO ^DIE
- KILL DA,DIE,DR
- END ;
- +1 KILL %,%DT,%H,%I,%ZIS,ALL,CNT,DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LN,NODE,NODE1,NODE9
- +2 KILL PG,PHARM,PHARMN,POP,PSD,PSD1,PSD2,PSDA,PSDATE,PSDED,PSDEV,PSDN,PSDOUT,PSDQTY,PSDR,PSDRG,PSDRN,PSDS,PSDSD,PSDSN,PSDT,PSDTYP,PSDUZ
- +3 KILL QTY,RPDT,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
- +4 QUIT
- DISPLAY ;display info
- +1 WRITE !!,"Transaction Information",!,LN,!
- +2 WRITE !,PSDRN,!,"Transaction Type: ",PSDTYP,!,"Date Entered: ",PSDATE,?50,"Quantity: ",PSDQTY,!,"Entered By: ",PSD1,!
- if PSD2]""
- WRITE "Witnessed By: ",PSD2,!
- +3 QUIT
