PSDORNO ;BIR/JPW,LTL - Nurse CS Order Request Entry (One time) ;15 Jan 95
;;3.0;CONTROLLED SUBSTANCES ;**20,79**;13 Feb 97;Build 20
;
; Reference to DD("DD" supported by DBIA # 10017
; Reference to PSD(58.8 supported by DBIA # 2711
;
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"
W ! D ^DIR K DIR Q:Y<1
I '$D(^PSD(58.8,+PSDS,1,PSDR,0)) S MSG=2 D MSG G END
S DIR(0)="DA^NOW::AEFT",DIR("A")="Date/time required: "
S DIR("?",1)="You are on the verge of creating a priority order."
S DIR("?",2)="If this is a mistake, enter ""^"" to create a scheduled order, otherwise,"
S DIR("?")="Pharmacy needs to know how soon you need this order."
W ! D ^DIR K DIR G:$D(DIRUT) END X ^DD("DD") S PSDT(9)=Y
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 I Y<1 W !,"Inactive drug" G END
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
D ASK^PSDORN1 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
Q:'$D(^PSD(58.8,NAOU,1,PSDR,0))
S PSDEM=1
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_";24////"_$G(PSDEM)_";13" D ^DIE K DIE,DR
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[HPSDORNO 2748 printed Dec 13, 2024@01:47:40 Page 2
PSDORNO ;BIR/JPW,LTL - Nurse CS Order Request Entry (One time) ;15 Jan 95
+1 ;;3.0;CONTROLLED SUBSTANCES ;**20,79**;13 Feb 97;Build 20
+2 ;
+3 ; Reference to DD("DD" supported by DBIA # 10017
+4 ; Reference to PSD(58.8 supported by DBIA # 2711
+5 ;
+6 SET DIR(0)="Y"
SET DIR("B")="No"
+7 SET DIR("A",1)="You have selected "_PSDRN
+8 SET DIR("A",2)="which is "_$SELECT('$GET(^PSD(58.8,+NAOU,1,PSDR,0)):"not stocked by ",1:"inactive on ")_NAOUN_"."
+9 SET DIR("A")="Are you sure you want to create a one time request"
+10 SET DIR("?")="^N XQH S XQH=""PSD ORDER ENTRY ONE TIME"" D EN^XQH"
+11 WRITE !
DO ^DIR
KILL DIR
if Y<1
QUIT
+12 IF '$DATA(^PSD(58.8,+PSDS,1,PSDR,0))
SET MSG=2
DO MSG
GOTO END
+13 SET DIR(0)="DA^NOW::AEFT"
SET DIR("A")="Date/time required: "
+14 SET DIR("?",1)="You are on the verge of creating a priority order."
+15 SET DIR("?",2)="If this is a mistake, enter ""^"" to create a scheduled order, otherwise,"
+16 SET DIR("?")="Pharmacy needs to know how soon you need this order."
+17 WRITE !
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO END
XECUTE ^DD("DD")
SET PSDT(9)=Y
+18 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
IF Y<1
WRITE !,"Inactive drug"
GOTO END
+19 SET NBKU=$PIECE(^PSD(58.8,+PSDS,1,PSDR,0),"^",8)
SET NPKG=+$PIECE(^(0),"^",9)
+20 IF NBKU']""
SET MSG1=3
DO MSG
GOTO END
+21 IF 'NPKG
SET MSG1=4
DO MSG
GOTO END
+22 WRITE !!,"Sending a Mailman message to the Pharmacy Supervisor(s)...",!!
+23 DO ^PSDORM
DO LIST^PSDORL
QTY KILL ORD
SET PSDOUT=0
SET PSDQTY=NPKG
SET CNT=0
DO DIE
if PSDOUT
GOTO END
+1 DO ASK^PSDORN1
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 if '$DATA(^PSD(58.8,NAOU,1,PSDR,0))
QUIT
+2 SET PSDEM=1
+3 FOR
LOCK +^PSD(58.8,NAOU,1,PSDR,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF $TEST
QUIT
+4 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_";24////"_$GET(PSDEM)_";13"
DO ^DIE
KILL DIE,DR
+5 LOCK -^PSD(58.8,NAOU,1,PSDR,0)
+6 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
