- 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
