PSJOE1 ;BIR/CML3-UD OE FOR COMBINED OE ;29 JAN 99 / 9:44 AM
;;5.0; INPATIENT MEDICATIONS ;**2,7,25,30,47,56,64**;16 DEC 97
;
; Reference to ^DICN is supported by DBIA# 10009
; Reference to ^VALM is supported by DBIA# 10118
;
S PC=0 G AD
;
EN ;
S PC=0
;
AD ; Ask Drug
N PSJNORD,PSGORQF,PSGSDX,PSGFDX,PSGNEFDO S PSJNORD=1 I $D(VALM("TM")) S IOTM=VALM("TM"),IOBM=IOSL W IOSC,@IOSTBM,IORC
D ^PSGOE7
I PSGORQF>0 S PSJORQF=1 G DONE
S PC=1,PSJORQF=0 I X?1"S."1.E D ^PSGOES G AD
D ^PSGOE4:'$P(PSJSYSP0,"^",12),^PSGOE3:$P(PSJSYSP0,"^",12)
G:$G(PSGOROE1)=1 AD
K PSGEFN,PSGOEEF,PSGOEE,PSGOEOS S PSGEFN="1:13" F X=1:1:13 S PSGEFN(X)=""
S PSGPDN=$$OINAME^PSJLMUTL(PSGPDRG),PSGPD=PSGPDRG,PSGOINST="",PSGSDN=$$ENDD^PSGMI(PSGNESD)_U_$$ENDTC^PSGMI(PSGNESD),PSGFDN=$$ENDD^PSGMI(PSGNEFD)_U_$$ENDTC^PSGMI(PSGNEFD)
S PSGAT=PSGS0Y,PSGLIN=$$ENDD^PSGMI(PSGDT)_U_$$ENDTC^PSGMI(PSGDT),PSGLI=PSGDT,PSGEBN=$$ENNPN^PSGMI(DUZ),PSGSTAT=$S(PSGOEAV:"ACTIVE",1:"NON-VERIFIED")
D CHK^PSGOEV("^^"_PSGMR_"^^^^"_PSGST,PSGPDRG_U_PSGDO,PSGSCH_U_PSGNESD_"^^"_PSGNEFD)
S PSGSD=PSGNESD,PSGFD=PSGNEFD
K PSJACEPT S VALMBCK="Q" D:$D(Y) EN^VALM("PSJU LM ACCEPT")
S PSJNOO=-1 I $G(PSJACEPT)=1 S PSJNOO=$$ENNOO^PSJUTL5("N")
I $G(PSJNOO)<0 K PSJACEPT W !,"No order created." G AD
K PSGOEE D ^PSGOETO S PSJORD=PSGORD I PSGOEAV D G AD
.I '$D(PSGOEE),+PSJSYSU=3 D EN^PSGPEN(PSGORD)
S PSGOEEF=0 D GETUD^PSJLMGUD(PSGP,PSGORD),ENSFE^PSGOEE0(PSGP,PSGORD),^PSGOE1,EN^VALM("PSJ LM UD ACTION")
G AD
Q
;
EDIT(PROMPT) ;
; Edit fields in a UD order.
; PROMPT=0 - Select fields to edit by number.
; PROMPT=1 - Prompt to select fields for editing.
;
;* D @$S('PROMPT:"ENEFA2^PSGON",1:"ENEFA^PSGON") Q:'Y S PSGOEEG=3 D EDIT^PSGOEE ;$S(PSGOEEWF[53.1:3,1:5) D:Y EDIT^PSGOEE
D @$S('PROMPT:"ENEFA2^PSGON",1:"ENEFA^PSGON") Q:'Y S:$G(PSJNEWOE) PSGOEEWF="^PS(53.1," S PSGOEEG=$S('$D(PSGOEEWF):3,PSGOEEWF[53.1:3,1:5) D EDIT^PSGOEE
I $G(PSJNEWOE) S PSGOEENO=0,DR="",VALMBCK="R"
I '$G(PSJNEWOE) D ENNOU^PSGOEE0 I 'PSGOEENO,DR="" S VALMBCK="R" Q
I 'PSGOEENO,$D(PSGOES) D ENNOU^PSGOEE0 ; only update on order sets
I 'PSGOEENO,$G(PSGPDNX)=1 D CKDT^PSGOEE
K VALMSG I PSGOEENO D
.S VALMSG="This change will cause a new order to be created." D GTSTATUS^PSGOEE,CHKDD^PSGOEE,CKDT^PSGOEE
.S PSGEBN=$$ENNPN^PSGMI(DUZ),PSGLIN=$$ENDD^PSGMI(PSGDT)_U_$$ENDTC^PSGMI(PSGDT),PSGLI=PSGDT
D CHK^PSGOEV("^^"_PSGMR_"^^^^"_PSGST,PSGPDRG_U_PSGDO,PSGSCH_U_PSGSD_"^^"_PSGFD)
D INIT^PSJLMUDE(PSGP,$G(PSGORD))
Q
DONE ;
K %,DA,DIC,DIE,DR,DRG,DRGN,DRGO,ND,OC,ORIFN,ORIT,ORPK,ORSTOP,ORSTRT,ORSTS,ORTX,PC,PSGDO,PSGMR,PSGMRN,PSGNEDFD,PSGNEFD,PSGNESD,PSGOES,PSGOROE1,PSGORD,PSGS0XT,PSGS0Y,PSGSCH,PSGSI,PSGX,Y,Z Q
;
GDO ;
W !!,"Drug is not found in Formulary List." F S %=1 W !,"Would you like to try to search the list again" D YN^DICN Q:% D TAM
Q:%<2
FTD ;
R !!,"Enter FREE TEXT DRUG: ",PSGDRGN:DTIME E W $C(7) S PSGDRGN="^" Q
Q:"^"[PSGDRGN S X=$S(PSGDRGN'?.ANP:"Control character(s)",PSGDRGN["^":"Up-arrow ('^') in text",$L(PSGDRGN)>39:"Reponse longer than 39 characters",1:"") I X]"" W $C(7)," ??",!?2,"(",X," not allowed.)" G FTD
Q:PSGDRGN'?1."?"
W !!?2,"ENTER DRUG ORDERED (1-39 CHARACTERS).",!?2,"Since the drug cannot be found in the DRUG file, enter the drug name here",!,"exactly as ordered. Press the RETURN key (or enter an '^') to skip over this",!,"drug, or to again search the"
W " DRUG file for this one." G FTD
;
TAM ; Try Again Message
W !!," Enter a 'Y' to try again to find the drug ordered from the Formulary. (The",!,"order cannot become active until a Formulary drug has been entered.) Enter 'N'",!,"to enter the drug ordered as free text for later reference."
W " Enter '^' to exit.",! Q
PSJOE1 ;BIR/CML3-UD OE FOR COMBINED OE ;29 JAN 99 / 9:44 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**2,7,25,30,47,56,64**;16 DEC 97
+2 ;
+3 ; Reference to ^DICN is supported by DBIA# 10009
+4 ; Reference to ^VALM is supported by DBIA# 10118
+5 ;
+6 SET PC=0
GOTO AD
+7 ;
EN ;
+1 SET PC=0
+2 ;
AD ; Ask Drug
+1 NEW PSJNORD,PSGORQF,PSGSDX,PSGFDX,PSGNEFDO
SET PSJNORD=1
IF $DATA(VALM("TM"))
SET IOTM=VALM("TM")
SET IOBM=IOSL
WRITE IOSC,@IOSTBM,IORC
+2 DO ^PSGOE7
+3 IF PSGORQF>0
SET PSJORQF=1
GOTO DONE
+4 SET PC=1
SET PSJORQF=0
IF X?1"S."1.E
DO ^PSGOES
GOTO AD
+5 IF '$PIECE(PSJSYSP0,"^",12)
DO ^PSGOE4
IF $PIECE(PSJSYSP0,"^",12)
DO ^PSGOE3
+6 IF $GET(PSGOROE1)=1
GOTO AD
+7 KILL PSGEFN,PSGOEEF,PSGOEE,PSGOEOS
SET PSGEFN="1:13"
FOR X=1:1:13
SET PSGEFN(X)=""
+8 SET PSGPDN=$$OINAME^PSJLMUTL(PSGPDRG)
SET PSGPD=PSGPDRG
SET PSGOINST=""
SET PSGSDN=$$ENDD^PSGMI(PSGNESD)_U_$$ENDTC^PSGMI(PSGNESD)
SET PSGFDN=$$ENDD^PSGMI(PSGNEFD)_U_$$ENDTC^PSGMI(PSGNEFD)
+9 SET PSGAT=PSGS0Y
SET PSGLIN=$$ENDD^PSGMI(PSGDT)_U_$$ENDTC^PSGMI(PSGDT)
SET PSGLI=PSGDT
SET PSGEBN=$$ENNPN^PSGMI(DUZ)
SET PSGSTAT=$SELECT(PSGOEAV:"ACTIVE",1:"NON-VERIFIED")
+10 DO CHK^PSGOEV("^^"_PSGMR_"^^^^"_PSGST,PSGPDRG_U_PSGDO,PSGSCH_U_PSGNESD_"^^"_PSGNEFD)
+11 SET PSGSD=PSGNESD
SET PSGFD=PSGNEFD
+12 KILL PSJACEPT
SET VALMBCK="Q"
IF $DATA(Y)
DO EN^VALM("PSJU LM ACCEPT")
+13 SET PSJNOO=-1
IF $GET(PSJACEPT)=1
SET PSJNOO=$$ENNOO^PSJUTL5("N")
+14 IF $GET(PSJNOO)<0
KILL PSJACEPT
WRITE !,"No order created."
GOTO AD
+15 KILL PSGOEE
DO ^PSGOETO
SET PSJORD=PSGORD
IF PSGOEAV
Begin DoDot:1
+16 IF '$DATA(PSGOEE)
IF +PSJSYSU=3
DO EN^PSGPEN(PSGORD)
End DoDot:1
GOTO AD
+17 SET PSGOEEF=0
DO GETUD^PSJLMGUD(PSGP,PSGORD)
DO ENSFE^PSGOEE0(PSGP,PSGORD)
DO ^PSGOE1
DO EN^VALM("PSJ LM UD ACTION")
+18 GOTO AD
+19 QUIT
+20 ;
EDIT(PROMPT) ;
+1 ; Edit fields in a UD order.
+2 ; PROMPT=0 - Select fields to edit by number.
+3 ; PROMPT=1 - Prompt to select fields for editing.
+4 ;
+5 ;* D @$S('PROMPT:"ENEFA2^PSGON",1:"ENEFA^PSGON") Q:'Y S PSGOEEG=3 D EDIT^PSGOEE ;$S(PSGOEEWF[53.1:3,1:5) D:Y EDIT^PSGOEE
+6 DO @$SELECT('PROMPT:"ENEFA2^PSGON",1:"ENEFA^PSGON")
IF 'Y
QUIT
IF $GET(PSJNEWOE)
SET PSGOEEWF="^PS(53.1,"
SET PSGOEEG=$SELECT('$DATA(PSGOEEWF):3,PSGOEEWF[53.1:3,1:5)
DO EDIT^PSGOEE
+7 IF $GET(PSJNEWOE)
SET PSGOEENO=0
SET DR=""
SET VALMBCK="R"
+8 IF '$GET(PSJNEWOE)
DO ENNOU^PSGOEE0
IF 'PSGOEENO
IF DR=""
SET VALMBCK="R"
QUIT
+9 ; only update on order sets
IF 'PSGOEENO
IF $DATA(PSGOES)
DO ENNOU^PSGOEE0
+10 IF 'PSGOEENO
IF $GET(PSGPDNX)=1
DO CKDT^PSGOEE
+11 KILL VALMSG
IF PSGOEENO
Begin DoDot:1
+12 SET VALMSG="This change will cause a new order to be created."
DO GTSTATUS^PSGOEE
DO CHKDD^PSGOEE
DO CKDT^PSGOEE
+13 SET PSGEBN=$$ENNPN^PSGMI(DUZ)
SET PSGLIN=$$ENDD^PSGMI(PSGDT)_U_$$ENDTC^PSGMI(PSGDT)
SET PSGLI=PSGDT
End DoDot:1
+14 DO CHK^PSGOEV("^^"_PSGMR_"^^^^"_PSGST,PSGPDRG_U_PSGDO,PSGSCH_U_PSGSD_"^^"_PSGFD)
+15 DO INIT^PSJLMUDE(PSGP,$GET(PSGORD))
+16 QUIT
DONE ;
+1 KILL %,DA,DIC,DIE,DR,DRG,DRGN,DRGO,ND,OC,ORIFN,ORIT,ORPK,ORSTOP,ORSTRT,ORSTS,ORTX,PC,PSGDO,PSGMR,PSGMRN,PSGNEDFD,PSGNEFD,PSGNESD,PSGOES,PSGOROE1,PSGORD,PSGS0XT,PSGS0Y,PSGSCH,PSGSI,PSGX,Y,Z
QUIT
+2 ;
GDO ;
+1 WRITE !!,"Drug is not found in Formulary List."
FOR
SET %=1
WRITE !,"Would you like to try to search the list again"
DO YN^DICN
IF %
QUIT
DO TAM
+2 IF %<2
QUIT
FTD ;
+1 READ !!,"Enter FREE TEXT DRUG: ",PSGDRGN:DTIME
IF '$TEST
WRITE $CHAR(7)
SET PSGDRGN="^"
QUIT
+2 IF "^"[PSGDRGN
QUIT
SET X=$SELECT(PSGDRGN'?.ANP:"Control character(s)",PSGDRGN["^":"Up-arrow ('^') in text",$LENGTH(PSGDRGN)>39:"Reponse longer than 39 characters",1:"")
IF X]""
WRITE $CHAR(7)," ??",!?2,"(",X," not allowed.)"
GOTO FTD
+3 IF PSGDRGN'?1."?"
QUIT
+4 WRITE !!?2,"ENTER DRUG ORDERED (1-39 CHARACTERS).",!?2,"Since the drug cannot be found in the DRUG file, enter the drug name here",!,"exactly as ordered. Press the RETURN key (or enter an '^') to skip over this",!,"drug, or to again search the
"
+5 WRITE " DRUG file for this one."
GOTO FTD
+6 ;
TAM ; Try Again Message
+1 WRITE !!," Enter a 'Y' to try again to find the drug ordered from the Formulary. (The",!,"order cannot become active until a Formulary drug has been entered.) Enter 'N'",!,"to enter the drug ordered as free text for later reference."
+2 WRITE " Enter '^' to exit.",!
QUIT
