- PSJOE0 ;BIR/CML3-INPATIENT PROFILE AND ORDER ENTRY ;Mar 06, 2020@10:39
- ;;5.0;INPATIENT MEDICATIONS;**47,56,110,133,162,241,267,275,302,366,319**;16 DEC 97;Build 31
- ;
- ; Reference to ^PS(51.2 is supported by DBIA 2178.
- ; Reference to ^PS(55 is supported by DBIA 2191.
- ; Reference to ^VA(200 is supported by DBIA 10060.
- ; Reference to ^DIR is supported by DBIA 10026.
- ;
- START ; print orders
- W:X]"" $P("^PROFILE",X,2) D ENL^PSJO3 G:PSJOL="^" DONE Q:PSJOL="N" K PSJPR S PSGOEAV=0,PSJNARC=1 D ^PSJO I 'PSJON Q
- ;
- ENVW ; ask user to select or view any of the orders shown
- S (PSGONC,PSGONR,PSGONV)=0,PSGLMT=PSJON S:$D(PSJPRF) PSGPRF=1 D ENASR^PSGON K PSGPRF
- G:X["^" DONE I X]"" S PSGOEA=""
- K PSJDLW
- I F PSJOE=1:1:PSGODDD S PSGOE=PSJOE F PSJOE1=1:1:$L(PSGODDD(PSJOE),",")-1 S PSJOE2=$P(PSGODDD(PSJOE),",",PSJOE1),(PSGORD,PSJORD)=^TMP("PSJON",$J,PSJOE2) G:$D(PSJDLW) DONE D
- .I PSJORD=+PSJORD N PSJO,PSJO1 S PSJO=PSJORD,PSJO1=0 F S PSJO1=$O(^PS(53.1,"ACX",PSJO,PSJO1)) Q:'PSJO1 Q:PSGOEA["^" Q:$D(PSJDLW) S PSJORD=PSJO1_"P" D GODO S PSJORD=""
- .Q:PSJORD="" Q:PSGOEA["^"
- .D GODO Q:PSGOEA["^"
- Q
- ;
- LMNEW(PSGP,PSJPROT) ;Entry point for new order entry from listman.
- ; PSGP = DFN
- ; PSJPROT=1:UD ONLY; 2:IV ONLY; 3:BOTH
- ;
- N PSJDEC,PSJCM01,PSJCMF S (PSJCM01,PSJCMF)=0 D CKNEW Q:$G(PSJDEC) N PSJUDPRF S PSJNEWOE=1
- S PSGPTS=PSJPTS,PSGOEAV=$P(PSJSYSP0,U,9)&PSJSYSU,PSGOEDMR="",PSGOEPR=$S($D(^PS(55,PSGP,5.1)):$P(^(5.1),"^",2),1:0),PSJORQF=0,PSJOEPF=""
- ;*366 - check provider credentials
- I PSGOEPR>0 S PSGOEPR=$S($$ACTPRO^PSGOE1(PSGOEPR):PSGOEPR,1:0)
- S:'PSGOEPR PSGOEPR=PSJPTSP
- S PSJPCAF=$S($G(PSJPCAF):PSJPCAF,1:"1")
- K P("CLIN"),P("APPT") ;P319 clean-up variables
- F PSJOE=0:0 Q:PSJORQF!('$P(PSJPCAF,"^",2)&(PSJPROT'>1)&('PSJCM01))!('(PSJPCAF&(PSJPROT'=2))&(PSJPROT'>1)&('PSJCM01))!(PSJCM01=-1) D KILL^PSJBCMA5(+$G(PSJSYSP)) D:$G(PSJCMO)!(PSJCM01) CM Q:PSJCM01=-1 D
- .D:(PSJPCAF&($P(PSJPCAF,"^",2))&(PSJPROT'=2))!(($G(PSJCMO)!(PSJCM01))&(PSJPROT'=2)) EN^PSJOE1 K PSGEFN,PSGOEF D:PSJCM01=-1 CMK Q:PSJCM01=-1 I PSJPROT>1 D ENIN^PSIVORE ;D:PSJCM01!$G(PSJCMO) CMK
- K PSJCM01,PSJCMO
- Q
- ;
- DONE ;
- K PSG,PSGDL,PSGDLS,PSGDO,PSGDRG,PSGDRGN,PSGFD,PSGHSM,PSGMR,PSGMRN,PSGNEDFD,PSGNEFD,PSGNESD,PSGOES,PSGOPR,PSGORD,PSGOROE1,PSGPR,PSGPRN,PSGS0XT,PSGS0Y,PSGSCH,PSGSD,PSGSI,PSGSM,PSGST,PSGSTN,PSGUD,PSGX,PSJDLW,PSJLM,PSJNARC,PSIVAC
- K P,PSGEFN,PSGOEEF
- Q
- CM ; Clinic Medication Order ;*p319
- D CM^PSJOE1
- I PSJCM01=-1 D CMK
- Q
- ;
- CMK ; Clean-up CM variables *p319
- K PSJCLAPP,P("CLIN"),P("CLINO"),P("APPT"),P("APPTO"),PSJCMF
- S VALMBCK="Q"
- Q
- ;
- CKNEW ;
- K CF,CHK,OD,PSGLMT,PSGODDD,PSGOEA,PSGON,PSGONC,PSGONR,PSGONV,PSGORD,PSJCOM,PSJOE1,PSJOE2 Q:$D(PSJPRF)
- D DEM^VADPT I $G(VADM(6)) W !!?2,"Patient is shown as deceased. You may not enter orders for this patient." S PSJDEC=1 D CONT Q
- I $G(PSJCMO) S PSJCM01=1 Q
- I 'PSJPCAF D
- .N DIR,X,Y W ! S DIR(0)="Y",DIR("A")="Is this a Clinic Medication order" D ^DIR
- .I Y=0 W !!,"(NOTE: You cannot enter Unit Dose orders for this patient.)" D CONT Q
- .I Y S PSJCM01=1 Q
- .I $D(DIRUT)!'Y S PSJDEC=1
- Q
- ;
- CONT ;
- K DIR S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR
- Q
- ;
- GODO ;Display selected order.
- S PSIVAC="C" I $S(PSJORD["V":1,PSJORD["P":$P($G(^PS(53.1,+PSJORD,0)),"^",4)="F",1:0) D @$S($D(PSJPRP):"ENINP^PSIVOPT(DFN,PSJORD)",1:"ENIN^PSIVOPT") G GODO1
- I '$D(PSJPRP),(PSJORD["P"),($P($G(^PS(53.1,+PSJORD,0)),U,4)="I") D ASKTYP Q:$D(DIRUT) I Y="I" D ENIN^PSIVOPT G GODO1
- S PSGORD=PSJORD D EN2^PSGVW,^PSGOE1:'$D(PSJPRF)
- GODO1 ;
- I $D(PSJPRP),'PSJPR K DIR S DIR(0)="E" D ^DIR K DIR S:$D(DUOUT)!$D(DTOUT) PSJDLW=1 Q:$D(PSJDLW) W:$Y @IOF
- Q
- ;
- ASKTYP ; Ask if completing as IV or UD.
- Q
- W !! D PIV^PSIVUTL(+PSJORD_"P")
- I $G(PSJPDD) S DIR(0)="E" D ^DIR S Y="I" Q
- W ! K DIR S DIR(0)="SOA^U:Unit Dose;I:IV Medication",DIR("A")="Do you wish to complete this as an IV or Unit Dose order (I/U)? ",DIR("?")="^D PENDIU^PSJO3" D ^DIR
- Q
- ;
- OLDCOM(DFN,PSJORD) ;
- Q:$$COMPLEX^PSJOE(DFN,PSJORD)
- N DURFLG S DURFLG=$S($G(PSJORD)["P":$G(^PS(53.1,+PSJORD,2.5)),$G(PSJORD)["V":$G(^PS(55,DFN,"IV",+PSJORD,2.5)),1:$G(^PS(55,DFN,5,+PSJORD,2.5))) I $P(DURFLG,"^",2)]"" D
- . D CLEAR^VALM1 W !!!!!?21," * WARNING * "
- . W !!!?5,"The following order contains a Requested Duration"
- . W !?12,"and may be part of a complex dose!"
- . W !!," Review the entire profile to determine appropriate action(s).",!!!!!!! D PAUSE^VALM1
- Q
- AM ;
- W !!?2,"Enter a 'Y' (or press the RETURN key) to enter new INPATIENT orders for this",!,"patient. Enter an 'N' (or an '^') if there are no new orders for this patient."
- W:'PSJPCAF !!?2,"PLEASE NOTE: The patient selected is NOT shown as currently admitted.",!,"Therefore, you cannot enter Unit Dose orders for this patient. (You can enter",!,"IV orders.)" Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJOE0 4826 printed Jan 18, 2025@03:09:21 Page 2
- PSJOE0 ;BIR/CML3-INPATIENT PROFILE AND ORDER ENTRY ;Mar 06, 2020@10:39
- +1 ;;5.0;INPATIENT MEDICATIONS;**47,56,110,133,162,241,267,275,302,366,319**;16 DEC 97;Build 31
- +2 ;
- +3 ; Reference to ^PS(51.2 is supported by DBIA 2178.
- +4 ; Reference to ^PS(55 is supported by DBIA 2191.
- +5 ; Reference to ^VA(200 is supported by DBIA 10060.
- +6 ; Reference to ^DIR is supported by DBIA 10026.
- +7 ;
- START ; print orders
- +1 if X]""
- WRITE $PIECE("^PROFILE",X,2)
- DO ENL^PSJO3
- if PSJOL="^"
- GOTO DONE
- if PSJOL="N"
- QUIT
- KILL PSJPR
- SET PSGOEAV=0
- SET PSJNARC=1
- DO ^PSJO
- IF 'PSJON
- QUIT
- +2 ;
- ENVW ; ask user to select or view any of the orders shown
- +1 SET (PSGONC,PSGONR,PSGONV)=0
- SET PSGLMT=PSJON
- if $DATA(PSJPRF)
- SET PSGPRF=1
- DO ENASR^PSGON
- KILL PSGPRF
- +2 if X["^"
- GOTO DONE
- IF X]""
- SET PSGOEA=""
- +3 KILL PSJDLW
- +4 IF $TEST
- FOR PSJOE=1:1:PSGODDD
- SET PSGOE=PSJOE
- FOR PSJOE1=1:1:$LENGTH(PSGODDD(PSJOE),",")-1
- SET PSJOE2=$PIECE(PSGODDD(PSJOE),",",PSJOE1)
- SET (PSGORD,PSJORD)=^TMP("PSJON",$JOB,PSJOE2)
- if $DATA(PSJDLW)
- GOTO DONE
- Begin DoDot:1
- +5 IF PSJORD=+PSJORD
- NEW PSJO,PSJO1
- SET PSJO=PSJORD
- SET PSJO1=0
- FOR
- SET PSJO1=$ORDER(^PS(53.1,"ACX",PSJO,PSJO1))
- if 'PSJO1
- QUIT
- if PSGOEA["^"
- QUIT
- if $DATA(PSJDLW)
- QUIT
- SET PSJORD=PSJO1_"P"
- DO GODO
- SET PSJORD=""
- +6 if PSJORD=""
- QUIT
- if PSGOEA["^"
- QUIT
- +7 DO GODO
- if PSGOEA["^"
- QUIT
- End DoDot:1
- +8 QUIT
- +9 ;
- LMNEW(PSGP,PSJPROT) ;Entry point for new order entry from listman.
- +1 ; PSGP = DFN
- +2 ; PSJPROT=1:UD ONLY; 2:IV ONLY; 3:BOTH
- +3 ;
- +4 NEW PSJDEC,PSJCM01,PSJCMF
- SET (PSJCM01,PSJCMF)=0
- DO CKNEW
- if $GET(PSJDEC)
- QUIT
- NEW PSJUDPRF
- SET PSJNEWOE=1
- +5 SET PSGPTS=PSJPTS
- SET PSGOEAV=$PIECE(PSJSYSP0,U,9)&PSJSYSU
- SET PSGOEDMR=""
- SET PSGOEPR=$SELECT($DATA(^PS(55,PSGP,5.1)):$PIECE(^(5.1),"^",2),1:0)
- SET PSJORQF=0
- SET PSJOEPF=""
- +6 ;*366 - check provider credentials
- +7 IF PSGOEPR>0
- SET PSGOEPR=$SELECT($$ACTPRO^PSGOE1(PSGOEPR):PSGOEPR,1:0)
- +8 if 'PSGOEPR
- SET PSGOEPR=PSJPTSP
- +9 SET PSJPCAF=$SELECT($GET(PSJPCAF):PSJPCAF,1:"1")
- +10 ;P319 clean-up variables
- KILL P("CLIN"),P("APPT")
- +11 FOR PSJOE=0:0
- if PSJORQF!('$PIECE(PSJPCAF,"^",2)&(PSJPROT'>1)&('PSJCM01))!('(PSJPCAF&(PSJPROT'=2))&(PSJPROT'>1)&('PSJCM01))!(PSJCM01=-1)
- QUIT
- DO KILL^PSJBCMA5(+$GET(PSJSYSP))
- if $GET(PSJCMO)!(PSJCM01)
- DO CM
- if PSJCM01=-1
- QUIT
- Begin DoDot:1
- +12 ;D:PSJCM01!$G(PSJCMO) CMK
- if (PSJPCAF&($PIECE(PSJPCAF,"^",2))&(PSJPROT'=2))!(($GET(PSJCMO)!(PSJCM01))&(PSJPROT'=2))
- DO EN^PSJOE1
- KILL PSGEFN,PSGOEF
- if PSJCM01=-1
- DO CMK
- if PSJCM01=-1
- QUIT
- IF PSJPROT>1
- DO ENIN^PSIVORE
- End DoDot:1
- +13 KILL PSJCM01,PSJCMO
- +14 QUIT
- +15 ;
- DONE ;
- +1 KILL PSG,PSGDL,PSGDLS,PSGDO,PSGDRG,PSGDRGN,PSGFD,PSGHSM,PSGMR,PSGMRN,PSGNEDFD,PSGNEFD,PSGNESD,PSGOES,PSGOPR,PSGORD,PSGOROE1,PSGPR,PSGPRN,PSGS0XT,PSGS0Y,PSGSCH,PSGSD,PSGSI,PSGSM,PSGST,PSGSTN,PSGUD,PSGX,PSJDLW,PSJLM,PSJNARC,PSIVAC
- +2 KILL P,PSGEFN,PSGOEEF
- +3 QUIT
- CM ; Clinic Medication Order ;*p319
- +1 DO CM^PSJOE1
- +2 IF PSJCM01=-1
- DO CMK
- +3 QUIT
- +4 ;
- CMK ; Clean-up CM variables *p319
- +1 KILL PSJCLAPP,P("CLIN"),P("CLINO"),P("APPT"),P("APPTO"),PSJCMF
- +2 SET VALMBCK="Q"
- +3 QUIT
- +4 ;
- CKNEW ;
- +1 KILL CF,CHK,OD,PSGLMT,PSGODDD,PSGOEA,PSGON,PSGONC,PSGONR,PSGONV,PSGORD,PSJCOM,PSJOE1,PSJOE2
- if $DATA(PSJPRF)
- QUIT
- +2 DO DEM^VADPT
- IF $GET(VADM(6))
- WRITE !!?2,"Patient is shown as deceased. You may not enter orders for this patient."
- SET PSJDEC=1
- DO CONT
- QUIT
- +3 IF $GET(PSJCMO)
- SET PSJCM01=1
- QUIT
- +4 IF 'PSJPCAF
- Begin DoDot:1
- +5 NEW DIR,X,Y
- WRITE !
- SET DIR(0)="Y"
- SET DIR("A")="Is this a Clinic Medication order"
- DO ^DIR
- +6 IF Y=0
- WRITE !!,"(NOTE: You cannot enter Unit Dose orders for this patient.)"
- DO CONT
- QUIT
- +7 IF Y
- SET PSJCM01=1
- QUIT
- +8 IF $DATA(DIRUT)!'Y
- SET PSJDEC=1
- End DoDot:1
- +9 QUIT
- +10 ;
- CONT ;
- +1 KILL DIR
- SET DIR(0)="EA"
- SET DIR("A")="Press Return to continue..."
- DO ^DIR
- +2 QUIT
- +3 ;
- GODO ;Display selected order.
- +1 SET PSIVAC="C"
- IF $SELECT(PSJORD["V":1,PSJORD["P":$PIECE($GET(^PS(53.1,+PSJORD,0)),"^",4)="F",1:0)
- DO @$SELECT($DATA(PSJPRP):"ENINP^PSIVOPT(DFN,PSJORD)",1:"ENIN^PSIVOPT")
- GOTO GODO1
- +2 IF '$DATA(PSJPRP)
- IF (PSJORD["P")
- IF ($PIECE($GET(^PS(53.1,+PSJORD,0)),U,4)="I")
- DO ASKTYP
- if $DATA(DIRUT)
- QUIT
- IF Y="I"
- DO ENIN^PSIVOPT
- GOTO GODO1
- +3 SET PSGORD=PSJORD
- DO EN2^PSGVW
- if '$DATA(PSJPRF)
- DO ^PSGOE1
- GODO1 ;
- +1 IF $DATA(PSJPRP)
- IF 'PSJPR
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- if $DATA(DUOUT)!$DATA(DTOUT)
- SET PSJDLW=1
- if $DATA(PSJDLW)
- QUIT
- if $Y
- WRITE @IOF
- +2 QUIT
- +3 ;
- ASKTYP ; Ask if completing as IV or UD.
- +1 QUIT
- +2 WRITE !!
- DO PIV^PSIVUTL(+PSJORD_"P")
- +3 IF $GET(PSJPDD)
- SET DIR(0)="E"
- DO ^DIR
- SET Y="I"
- QUIT
- +4 WRITE !
- KILL DIR
- SET DIR(0)="SOA^U:Unit Dose;I:IV Medication"
- SET DIR("A")="Do you wish to complete this as an IV or Unit Dose order (I/U)? "
- SET DIR("?")="^D PENDIU^PSJO3"
- DO ^DIR
- +5 QUIT
- +6 ;
- OLDCOM(DFN,PSJORD) ;
- +1 if $$COMPLEX^PSJOE(DFN,PSJORD)
- QUIT
- +2 NEW DURFLG
- SET DURFLG=$SELECT($GET(PSJORD)["P":$GET(^PS(53.1,+PSJORD,2.5)),$GET(PSJORD)["V":$GET(^PS(55,DFN,"IV",+PSJORD,2.5)),1:$GET(^PS(55,DFN,5,+PSJORD,2.5)))
- IF $PIECE(DURFLG,"^",2)]""
- Begin DoDot:1
- +3 DO CLEAR^VALM1
- WRITE !!!!!?21," * WARNING * "
- +4 WRITE !!!?5,"The following order contains a Requested Duration"
- +5 WRITE !?12,"and may be part of a complex dose!"
- +6 WRITE !!," Review the entire profile to determine appropriate action(s).",!!!!!!!
- DO PAUSE^VALM1
- End DoDot:1
- +7 QUIT
- AM ;
- +1 WRITE !!?2,"Enter a 'Y' (or press the RETURN key) to enter new INPATIENT orders for this",!,"patient. Enter an 'N' (or an '^') if there are no new orders for this patient."
- +2 if 'PSJPCAF
- WRITE !!?2,"PLEASE NOTE: The patient selected is NOT shown as currently admitted.",!,"Therefore, you cannot enter Unit Dose orders for this patient. (You can enter",!,"IV orders.)"
- QUIT