PSDORD4 ;BIR/JPW,LTL - Nurse CS Order Request Entry (One time) ;22 May 95
;;3.0;CONTROLLED SUBSTANCES ;**79**;13 Feb 97;Build 20
S DIR(0)="Y",DIR("B")="No"
S DIR("A",1)="You have selected "_PSDRN
S DIR("A",2)="which is "_$S('$G(^PSD(58.8,+NAOU,1,PSDR,0)):"not stocked by ",1:"inactive on ")_NAOUN_"."
S DIR("A")="Are you sure you want to create a one time request"
S DIR("?")="^N XQH S XQH=""PSD ORDER ENTRY ONE TIME"" D EN^XQH"
D ^DIR K DIR Q:Y<1
I '$D(^PSD(58.8,+PSDS,1,PSDR,0)) S MSG=2 D MSG G END
I '$D(^PSD(58.8,+NAOU,1,+PSDR,0)) S DA(1)=+NAOU,DIC="^PSD(58.8,+NAOU,1,",DIC(0)="L",DLAYGO=58.8,X="`"_PSDR,DIC("DR")="13////"_DT_";14////"_"O"_";14.5////"_"One Time Request",DINUM=PSDR D ^DIC K DIC,DLAYGO
S NBKU=$P(^PSD(58.8,+PSDS,1,PSDR,0),"^",8),NPKG=+$P(^(0),"^",9)
I NBKU']"" S MSG1=3 D MSG G END
I 'NPKG S MSG1=4 D MSG G END
W !!,"Sending a Mailman message to the Pharmacy Supervisor(s)...",!!
D ^PSDORM,LIST^PSDORL
QTY K ORD S PSDOUT=0 S PSDQTY=NPKG,CNT=0 D DIE G:PSDOUT END
END K %,%DT,%H,%I,CNT,CNT1,DA,DIC,DIE,DINUM,DIR,DIROUT,DIRUT,DIWF,DIWL,DIWR,DR,DTOUT,DUOUT,LN,MSG,MSG1
K PSDEM,PSDOUT,X,Y
Q
DIE ;create the order request
F L +^PSD(58.8,NAOU,1,PSDR,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
S:'$D(^PSD(58.8,NAOU,1,PSDR,3,0)) ^(0)="^58.800118A^^"
DIE2 S PSDA=$P(^PSD(58.8,NAOU,1,PSDR,3,0),"^",3)+1 I $D(^PSD(58.8,NAOU,1,PSDR,3,PSDA)) S $P(^PSD(58.8,NAOU,1,PSDR,3,0),"^",3)=$P(^PSD(58.8,NAOU,1,PSDR,3,0),"^",3)+1 G DIE2
K DA,DIC,DIE,DD,DR,DO S DIC(0)="L",(DIC,DIE)="^PSD(58.8,"_NAOU_",1,"_PSDR_",3,",DA(2)=NAOU,DA(1)=PSDR,(X,DINUM)=PSDA D FILE^DICN K DIC
D NOW^%DTC S PSDT=+$E(%,1,12)
W ?10,!!,"processing one order for ",PSDQTY," now..."
S DA=PSDA,DA(1)=PSDR,DA(2)=NAOU,DR="1////"_PSDT_";2////"_+PSDS_";3////"_PSDUZ_";10////1;5////"_PSDQTY_";13" D ^DIE K DIE,DR
S PSDA(+PSDR,+PSDA)=$G(^PSD(58.8,+NAOU,1,+PSDR,3,PSDA,0))
L -^PSD(58.8,NAOU,1,PSDR,0)
Q
MSG ;display error message
W $C(7),!!,?10,"Contact your Pharmacy Coordinator.",!,?10,"This "_$S(MSG=2:"Dispensing Site",MSG=1:"NAOU",1:"Drug")_" is missing "
W $S(MSG1=1:"Primary Disp. Site",MSG1=2:"stocked drugs",MSG1=3:"narcotic breakdown unit",MSG1=4:"narcotic package size",1:"data")_".",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDORD4 2220 printed Oct 16, 2024@17:48:23 Page 2
PSDORD4 ;BIR/JPW,LTL - Nurse CS Order Request Entry (One time) ;22 May 95
+1 ;;3.0;CONTROLLED SUBSTANCES ;**79**;13 Feb 97;Build 20
+2 SET DIR(0)="Y"
SET DIR("B")="No"
+3 SET DIR("A",1)="You have selected "_PSDRN
+4 SET DIR("A",2)="which is "_$SELECT('$GET(^PSD(58.8,+NAOU,1,PSDR,0)):"not stocked by ",1:"inactive on ")_NAOUN_"."
+5 SET DIR("A")="Are you sure you want to create a one time request"
+6 SET DIR("?")="^N XQH S XQH=""PSD ORDER ENTRY ONE TIME"" D EN^XQH"
+7 DO ^DIR
KILL DIR
if Y<1
QUIT
+8 IF '$DATA(^PSD(58.8,+PSDS,1,PSDR,0))
SET MSG=2
DO MSG
GOTO END
+9 IF '$DATA(^PSD(58.8,+NAOU,1,+PSDR,0))
SET DA(1)=+NAOU
SET DIC="^PSD(58.8,+NAOU,1,"
SET DIC(0)="L"
SET DLAYGO=58.8
SET X="`"_PSDR
SET DIC("DR")="13////"_DT_";14////"_"O"_";14.5////"_"One Time Request"
SET DINUM=PSDR
DO ^DIC
KILL DIC,DLAYGO
+10 SET NBKU=$PIECE(^PSD(58.8,+PSDS,1,PSDR,0),"^",8)
SET NPKG=+$PIECE(^(0),"^",9)
+11 IF NBKU']""
SET MSG1=3
DO MSG
GOTO END
+12 IF 'NPKG
SET MSG1=4
DO MSG
GOTO END
+13 WRITE !!,"Sending a Mailman message to the Pharmacy Supervisor(s)...",!!
+14 DO ^PSDORM
DO LIST^PSDORL
QTY KILL ORD
SET PSDOUT=0
SET PSDQTY=NPKG
SET CNT=0
DO DIE
if PSDOUT
GOTO END
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 PSDEM,PSDOUT,X,Y
+2 QUIT
DIE ;create the order request
+1 FOR
LOCK +^PSD(58.8,NAOU,1,PSDR,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF $TEST
QUIT
+2 if '$DATA(^PSD(58.8,NAOU,1,PSDR,3,0))
SET ^(0)="^58.800118A^^"
DIE2 SET PSDA=$PIECE(^PSD(58.8,NAOU,1,PSDR,3,0),"^",3)+1
IF $DATA(^PSD(58.8,NAOU,1,PSDR,3,PSDA))
SET $PIECE(^PSD(58.8,NAOU,1,PSDR,3,0),"^",3)=$PIECE(^PSD(58.8,NAOU,1,PSDR,3,0),"^",3)+1
GOTO DIE2
+1 KILL DA,DIC,DIE,DD,DR,DO
SET DIC(0)="L"
SET (DIC,DIE)="^PSD(58.8,"_NAOU_",1,"_PSDR_",3,"
SET DA(2)=NAOU
SET DA(1)=PSDR
SET (X,DINUM)=PSDA
DO FILE^DICN
KILL DIC
+2 DO NOW^%DTC
SET PSDT=+$EXTRACT(%,1,12)
+3 WRITE ?10,!!,"processing one order for ",PSDQTY," now..."
+4 SET DA=PSDA
SET DA(1)=PSDR
SET DA(2)=NAOU
SET DR="1////"_PSDT_";2////"_+PSDS_";3////"_PSDUZ_";10////1;5////"_PSDQTY_";13"
DO ^DIE
KILL DIE,DR
+5 SET PSDA(+PSDR,+PSDA)=$GET(^PSD(58.8,+NAOU,1,+PSDR,3,PSDA,0))
+6 LOCK -^PSD(58.8,NAOU,1,PSDR,0)
+7 QUIT
MSG ;display error message
+1 WRITE $CHAR(7),!!,?10,"Contact your Pharmacy Coordinator.",!,?10,"This "_$SELECT(MSG=2:"Dispensing Site",MSG=1:"NAOU",1:"Drug")_" is missing "
+2 WRITE $SELECT(MSG1=1:"Primary Disp. Site",MSG1=2:"stocked drugs",MSG1=3:"narcotic breakdown unit",MSG1=4:"narcotic package size",1:"data")_".",!
+3 QUIT
