- PSJORRE1 ;BIR/MV - RETURN INPATIENT ACTIVE MEDS (EXPANDED) ;Nov 10, 2020@15:00:22
- ;;5.0;INPATIENT MEDICATIONS;**22,51,50,58,81,91,110,111,134,225,275,315,319,399**;16 DEC 97;Build 64
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ; Reference to ^PS(51.2 is supported by DBIA 2178.
- ; Reference to ^PS(52.6 is supported by DBIA 1231.
- ; Reference to ^PS(52.7 is supported by DBIA 2173.
- ; Reference to ^PS(55 is supported by DBIA 2191.
- ; Reference to ^PSDRUG is supported by DBIA 2192.
- ; Reference to ^TMP("PS" is documented in DBIA #2384.
- ;
- OEL(DFN,ON) ; return list of expanded inpat meds
- K ^TMP("PS",$J)
- N ADM,CNT,DN,DO,F,INFUS,INST,MR,ND,ND0,ND2,ND2P1,ND2P5,ND6,NDOI,SCH,SIO,START,STAT,STOP,TYP,UNITS,X,Y,IND ;*315,*399
- S F=$S(ON["P":"^PS(53.1,",ON["U":"^PS(55,DFN,5,",1:"^PS(55,"_DFN_",""IV"",")
- I ON'["P",'$D(@(F_+ON_")")) Q
- I ON["P" S X=$G(^PS(53.1,+ON,0)) Q:$P(X,U,15)'=DFN S TYP=$P(X,U,4) D @$S(TYP="U":"UDTMP",1:"IVTMP")
- I ON["P" D ;*319
- . M ^TMP("PS",$J,"ALOG")=^PS(53.1,+ON,"A")
- . S ^TMP("PS",$J,"ALOG",0)=+$O(^TMP("PS",$J,"ALOG",""),-1)
- D:ON'["P" @$S(ON["U":"UDTMP",1:"IVTMP")
- S Y=$S(ON["V":5,1:12),CNT=0
- I $O(@(F_+ON_","_Y_",0)")) D
- . F X=0:0 S X=$O(@(F_+ON_","_Y_","_X_")")) Q:'X D
- ..S CNT=CNT+1,ND=$G(@(F_+ON_","_Y_","_X_",0)")),^TMP("PS",$J,"PC",CNT,0)=ND
- S ^TMP("PS",$J,"PC",0)=CNT
- Q
- ;
- UDTMP ;*** Set ^TMP for Unit dose orders.
- N DO,DN,INST,X,Y,PROVIDER,NOTGIVEN,RNWDT
- S (MR,SCH,INST)=""
- S ND2=$G(@(F_+ON_",2)")),ND0=$G(@(F_+ON_",0)"))
- S ND2P1=$G(@(F_+ON_",2.1)")) ;*315
- S ND6=$P($G(@(F_+ON_",6)")),"^") S:ND6["Instructions too long. See Order View or BCMA for full text." ND6="Instructions too long. See order details for full text."
- S RNWDT=$$LASTREN^PSJLMPRI(DFN,ON) I RNWDT S RNWDT=+RNWDT
- S STAT=$$CODES^PSIVUTL($P(ND0,U,9),$S(ON["P":53.1,1:55.06),28)
- S NDOI=$G(@(F_+ON_",.2)")),DO=$P(NDOI,U,2)
- S DN(1)=$$OIDF^PSJLMUT1(NDOI) I DN(1)="" K DN D DRGDISP^PSJLMUT1(DFN,ON,40,0,.DN,1)
- ;*225 Don't allow 0 units
- S UNITS="" I '$O(@(F_+ON_",1,1)")) S UNITS=$P($G(@(F_+ON_",1,1,0)")),U,2) S:(ON["U")&(+UNITS=0) UNITS=1
- S MR=$$MR(+$P(ND0,U,3)),INST=$G(@(F_+ON_",.3)"))
- S NOTGIVEN=$S(ON["U":$P($G(^PS(55,DFN,5,+ON,0)),"^",22),1:"")
- S ^TMP("PS",$J,0)=DN(1)_"^^"_$P(ND2,U,4)_"^^"_$P(ND2,U,2)_U_STAT_"^^^"_DO_U_UNITS_U_$P(ND0,U,21)_U_U_NOTGIVEN_U_($P(ND0,U,9)="P"&($P(ND0,U,24)="R"))_U_U_$G(RNWDT)
- S PROVIDER=$P($G(@(F_+ON_",0)")),"^",2)
- I PROVIDER S ^TMP("PS",$J,"P",0)=PROVIDER_"^"_$P($G(^VA(200,PROVIDER,0)),"^")
- S ^TMP("PS",$J,"MDR",0)=MR]"" S:MR]"" ^TMP("PS",$J,"MDR",1,0)=MR
- S ^TMP("PS",$J,"SCH",0)=$P(ND2,U)]"" S:$P(ND2,U)]"" ^TMP("PS",$J,"SCH",1,0)=$P(ND2,U)
- S:$P(ND0,U,7)]"" ^TMP("PS",$J,"SCH",0)=1,$P(^TMP("PS",$J,"SCH",1,0),U,2)=$$GTSCHT($P(ND0,U,7))_"^"_$P(ND0,U,7)
- S ^TMP("PS",$J,"SIG",0)=INST]"" S:INST]"" ^TMP("PS",$J,"SIG",1,0)=INST
- S ^TMP("PS",$J,"ADM",0)=$P(ND2,U,5)]"" S:$P(ND2,U,5)]"" ^TMP("PS",$J,"ADM",1,0)=$P(ND2,U,5)
- S ^TMP("PS",$J,"RMV",0)=$P(ND2P1,U,2)]"" S:$P(ND2P1,U,2)]"" ^TMP("PS",$J,"RMV",1,0)=$P(ND2P1,U,2) ;*315
- S ^TMP("PS",$J,"SIO",0)=ND6]"" S:ND6]"" ^TMP("PS",$J,"SIO",1,0)=ND6
- S IND=$P($G(@(F_+ON_",18)")),"^") ;*399-IND
- I IND]"" S ^TMP("PS",$J,"IND",0)=1,^TMP("PS",$J,"IND",1,0)=IND
- NEW VERPHARM S:ON["U" VERPHARM=$P($G(@(F_+ON_",4)")),U,3)
- S:+$G(VERPHARM) $P(^TMP("PS",$J,"RXN",0),U,5)=VERPHARM
- NEW PSJDD,INACTDT,NDDD,OUTOI,PSJOUT S CNT=0
- F PSJDD=0:0 S PSJDD=$O(@(F_+ON_",1,PSJDD)")) Q:'PSJDD D
- . S NDDD=@(F_+ON_",1,PSJDD,0)")
- . I $P(NDDD,U,3)]"",($P(NDDD,U,3)'>DT) Q
- . S PSJOUT=$P($G(^PSDRUG(+NDDD,8)),U,5)
- . I +PSJOUT D
- .. S INACTDT=$G(^PSDRUG(+PSJOUT,"I")),OUTOI=+$G(^PSDRUG(+PSJOUT,2))
- .. I INACTDT]"",(INACTDT'>DT) S (PSJOUT,OUTOI)=""
- . I '+PSJOUT,($P($G(^PSDRUG(+NDDD,2)),U,3)["O") D
- .. S PSJOUT=+NDDD,OUTOI=+NDOI
- .. S INACTDT=$G(^PSDRUG(+NDDD,"I"))
- .. I INACTDT]"",(INACTDT'>DT) S (PSJOUT,OUTOI)=""
- . S UNITS=$P(NDDD,U,2) S:(ON["U")&(UNITS="") UNITS=1
- . S CNT=CNT+1,^TMP("PS",$J,"DD",CNT,0)=+NDDD_U_UNITS_U_PSJOUT_U_$G(OUTOI)
- S ^TMP("PS",$J,"DD",0)=CNT
- Q
- ;
- IVTMP ;*** Set ^TMP for IV orders.
- N PROVIDER,RNWDT,IVLIM S ND0=$G(@(F_+ON_",0)")),CNT=0
- F X=0:0 S X=$O(@(F_+ON_",""AD"","_X_")")) Q:'X S ND=$G(@(F_+ON_",""AD"","_X_",0)")),DN=$P($G(^PS(52.6,+ND,0)),U),Y=DN_U_$P(ND,U,2) S:$P(ND,U,3) Y=Y_U_$P(ND,U,3) S CNT=CNT+1,^TMP("PS",$J,"A",CNT,0)=Y
- S RNWDT=$$LASTREN^PSJLMPRI(DFN,ON) I RNWDT S RNWDT=+RNWDT
- S ^TMP("PS",$J,"A",0)=CNT,CNT=0
- F X=0:0 S X=$O(@(F_+ON_",""SOL"","_X_")")) Q:'X S ND=$G(@(F_+ON_",""SOL"","_X_",0)")),DN=$G(^PS(52.7,+ND,0)),CNT=CNT+1,^TMP("PS",$J,"B",CNT,0)=$P(DN,U)_U_$P(ND,U,2)_U_$P(DN,U,4)
- S ^TMP("PS",$J,"B",0)=CNT
- S INST=$G(@(F_+ON_",.3)"))
- I ON["P" D
- . S SCH=$P($G(^PS(53.1,+ON,2)),U)
- . S PROVIDER=$P(ND0,U,2)
- . S MR=$$MR(+$P(ND0,U,3)),STAT=$$CODES^PSIVUTL($P(ND0,U,9),53.1,28)
- . S INFUS=$P($G(^PS(53.1,+ON,8)),U,5)
- . S ND2=$G(@(F_+ON_",2)")),START=$P(ND2,U,2),STOP=$P(ND2,U,4)
- . S ADM=$P(ND2,U,5),SIO=$P($G(@(F_+ON_",6)")),"^")
- . S:($G(SIO)["Instructions too long. See Order View or BCMA for full text") SIO="Instructions too long. See order details for full text."
- . S ND2P5=$G(@(F_+ON_",2.5)")) S IVLIM=$P(ND2P5,U,4) I $E(IVLIM)="a" S IVLIM="doses"_$P(IVLIM,"a",2)
- . I IVLIM="" S IVLIM=$P(ND2P5,U,2) S:(IVLIM'["d")&(IVLIM'["h") IVLIM=""
- I ON'["P" D
- . S PROVIDER=$P(ND0,U,6)
- . S SCH=$P(ND0,U,9),INFUS=$P(ND0,U,8),STAT=$$CODES^PSIVUTL($P(ND0,U,17),55.01,100)
- . S MR=$$MR(+$P($G(^PS(55,DFN,"IV",+ON,.2)),U,3))
- . S START=$P(ND0,U,2),STOP=$P(ND0,U,3)
- . S ADM=$P(ND0,U,11),SIO=$P($G(@(F_+ON_",3)")),"^")
- . S:($G(SIO)["Instructions too long. See Order View or BCMA for full text") SIO="Instructions too long. See order details for full text."
- . NEW VERPHARM S VERPHARM=$P($G(^PS(55,DFN,"IV",+ON,4)),U,4)
- . S:+VERPHARM $P(^TMP("PS",$J,"RXN",0),U,5)=VERPHARM
- . S ND2P5=$G(@(F_+ON_",2.5)")) S IVLIM=$P(ND2P5,U,4) I IVLIM="" S IVLIM=$P(ND2P5,U,2) S:(IVLIM'["d")&(IVLIM'["h") IVLIM=""
- S DN=$G(@(F_+ON_",.2)")),DO=$P(DN,U,2)
- S DN=$S(+$P(DN,U):$$OIDF^PSJLMUT1($P(DN,U)),1:"")
- S ^TMP("PS",$J,0)=DN_U_INFUS_U_STOP_"^^"_START_U_STAT_"^^^"_DO_"^^"_$P(ND0,U,21)_U_U_U_($P(ND0,U,9)="P"&($P(ND0,U,24)="R"))_U_U_$G(RNWDT)
- I PROVIDER S ^TMP("PS",$J,"P",0)=PROVIDER_"^"_$P($G(^VA(200,PROVIDER,0)),"^")
- S ^TMP("PS",$J,"MDR",0)=MR]"" S:MR]"" ^TMP("PS",$J,"MDR",1,0)=MR
- S ^TMP("PS",$J,"SCH",0)=SCH]"" S:SCH]"" ^TMP("PS",$J,"SCH",1,0)=SCH
- I ON["P" S:$P(ND0,U,7)]"" ^TMP("PS",$J,"SCH",0)=1,$P(^TMP("PS",$J,"SCH",1,0),U,2)=$$GTSCHT($P(ND0,U,7))_"^"_$P(ND0,U,7)
- S ^TMP("PS",$J,"SIG",0)=INST]"" S:INST]"" ^TMP("PS",$J,"SIG",1,0)=INST
- S ^TMP("PS",$J,"ADM",0)=ADM]"" S:ADM]"" ^TMP("PS",$J,"ADM",1,0)=ADM
- S ^TMP("PS",$J,"SIO",0)=SIO]"" S:SIO]"" ^TMP("PS",$J,"SIO",1,0)=SIO
- I $G(IVLIM)]"" S ^TMP("PS",$J,"IVLIM",0)=$G(IVLIM)
- S IND=$P($G(@(F_+ON_",18)")),"^") ;*399-IND
- I IND]"" S ^TMP("PS",$J,"IND",0)=1,^TMP("PS",$J,"IND",1,0)=IND
- Q
- ;
- MR(X) ;RETURN MED ROUTE ABBR. IF THE ABBR="" RETURN MED ROUTE'S NAME.
- S X=$G(^PS(51.2,X,0))
- Q $S($P(X,U,3)]"":$P(X,U,3),1:$P(X,U))
- ;
- GTSTAT(X) ;
- Q $S(X="A":"ACTIVE",X="D":"DISCONTINUED",X="I":"INCOMPLETE",X="N":"NON-VERFIED",X="U":"UNRELEASED",X="P":"PENDING",X="DE":"DISCONTINUED (EDIT)",X="O":"ON CALL",1:"NOT FOUND")
- ;
- VA200(X) ;Return the IEN for the user.
- ; X = User name
- NEW DIC,Y S DIC="^VA(200,",DIC(0)="NZ" D ^DIC
- I +Y=-1 Q ""
- Q $P(Y,U)
- GTSCHT(X) ;
- Q $S(X="C":"CONTINUOUS",X="O":"ONE TIME",X="P":"PRN",X="R":"FILL ON REQUEST",X="OC":"ON CALL",1:"NOT FOUND")
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJORRE1 7539 printed Feb 18, 2025@23:34:46 Page 2
- PSJORRE1 ;BIR/MV - RETURN INPATIENT ACTIVE MEDS (EXPANDED) ;Nov 10, 2020@15:00:22
- +1 ;;5.0;INPATIENT MEDICATIONS;**22,51,50,58,81,91,110,111,134,225,275,315,319,399**;16 DEC 97;Build 64
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ; Reference to ^PS(51.2 is supported by DBIA 2178.
- +4 ; Reference to ^PS(52.6 is supported by DBIA 1231.
- +5 ; Reference to ^PS(52.7 is supported by DBIA 2173.
- +6 ; Reference to ^PS(55 is supported by DBIA 2191.
- +7 ; Reference to ^PSDRUG is supported by DBIA 2192.
- +8 ; Reference to ^TMP("PS" is documented in DBIA #2384.
- +9 ;
- OEL(DFN,ON) ; return list of expanded inpat meds
- +1 KILL ^TMP("PS",$JOB)
- +2 ;*315,*399
- NEW ADM,CNT,DN,DO,F,INFUS,INST,MR,ND,ND0,ND2,ND2P1,ND2P5,ND6,NDOI,SCH,SIO,START,STAT,STOP,TYP,UNITS,X,Y,IND
- +3 SET F=$SELECT(ON["P":"^PS(53.1,",ON["U":"^PS(55,DFN,5,",1:"^PS(55,"_DFN_",""IV"",")
- +4 IF ON'["P"
- IF '$DATA(@(F_+ON_")"))
- QUIT
- +5 IF ON["P"
- SET X=$GET(^PS(53.1,+ON,0))
- if $PIECE(X,U,15)'=DFN
- QUIT
- SET TYP=$PIECE(X,U,4)
- DO @$SELECT(TYP="U":"UDTMP",1:"IVTMP")
- +6 ;*319
- IF ON["P"
- Begin DoDot:1
- +7 MERGE ^TMP("PS",$JOB,"ALOG")=^PS(53.1,+ON,"A")
- +8 SET ^TMP("PS",$JOB,"ALOG",0)=+$ORDER(^TMP("PS",$JOB,"ALOG",""),-1)
- End DoDot:1
- +9 if ON'["P"
- DO @$SELECT(ON["U":"UDTMP",1:"IVTMP")
- +10 SET Y=$SELECT(ON["V":5,1:12)
- SET CNT=0
- +11 IF $ORDER(@(F_+ON_","_Y_",0)"))
- Begin DoDot:1
- +12 FOR X=0:0
- SET X=$ORDER(@(F_+ON_","_Y_","_X_")"))
- if 'X
- QUIT
- Begin DoDot:2
- +13 SET CNT=CNT+1
- SET ND=$GET(@(F_+ON_","_Y_","_X_",0)"))
- SET ^TMP("PS",$JOB,"PC",CNT,0)=ND
- End DoDot:2
- End DoDot:1
- +14 SET ^TMP("PS",$JOB,"PC",0)=CNT
- +15 QUIT
- +16 ;
- UDTMP ;*** Set ^TMP for Unit dose orders.
- +1 NEW DO,DN,INST,X,Y,PROVIDER,NOTGIVEN,RNWDT
- +2 SET (MR,SCH,INST)=""
- +3 SET ND2=$GET(@(F_+ON_",2)"))
- SET ND0=$GET(@(F_+ON_",0)"))
- +4 ;*315
- SET ND2P1=$GET(@(F_+ON_",2.1)"))
- +5 SET ND6=$PIECE($GET(@(F_+ON_",6)")),"^")
- if ND6["Instructions too long. See Order View or BCMA for full text."
- SET ND6="Instructions too long. See order details for full text."
- +6 SET RNWDT=$$LASTREN^PSJLMPRI(DFN,ON)
- IF RNWDT
- SET RNWDT=+RNWDT
- +7 SET STAT=$$CODES^PSIVUTL($PIECE(ND0,U,9),$SELECT(ON["P":53.1,1:55.06),28)
- +8 SET NDOI=$GET(@(F_+ON_",.2)"))
- SET DO=$PIECE(NDOI,U,2)
- +9 SET DN(1)=$$OIDF^PSJLMUT1(NDOI)
- IF DN(1)=""
- KILL DN
- DO DRGDISP^PSJLMUT1(DFN,ON,40,0,.DN,1)
- +10 ;*225 Don't allow 0 units
- +11 SET UNITS=""
- IF '$ORDER(@(F_+ON_",1,1)"))
- SET UNITS=$PIECE($GET(@(F_+ON_",1,1,0)")),U,2)
- if (ON["U")&(+UNITS=0)
- SET UNITS=1
- +12 SET MR=$$MR(+$PIECE(ND0,U,3))
- SET INST=$GET(@(F_+ON_",.3)"))
- +13 SET NOTGIVEN=$SELECT(ON["U":$PIECE($GET(^PS(55,DFN,5,+ON,0)),"^",22),1:"")
- +14 SET ^TMP("PS",$JOB,0)=DN(1)_"^^"_$PIECE(ND2,U,4)_"^^"_$PIECE(ND2,U,2)_U_STAT_"^^^"_DO_U_UNITS_U_$PIECE(ND0,U,21)_U_U_NOTGIVEN_U_($PIECE(ND0,U,9)="P"&($PIECE(ND0,U,24)="R"))_U_U_$GET(RNWDT)
- +15 SET PROVIDER=$PIECE($GET(@(F_+ON_",0)")),"^",2)
- +16 IF PROVIDER
- SET ^TMP("PS",$JOB,"P",0)=PROVIDER_"^"_$PIECE($GET(^VA(200,PROVIDER,0)),"^")
- +17 SET ^TMP("PS",$JOB,"MDR",0)=MR]""
- if MR]""
- SET ^TMP("PS",$JOB,"MDR",1,0)=MR
- +18 SET ^TMP("PS",$JOB,"SCH",0)=$PIECE(ND2,U)]""
- if $PIECE(ND2,U)]""
- SET ^TMP("PS",$JOB,"SCH",1,0)=$PIECE(ND2,U)
- +19 if $PIECE(ND0,U,7)]""
- SET ^TMP("PS",$JOB,"SCH",0)=1
- SET $PIECE(^TMP("PS",$JOB,"SCH",1,0),U,2)=$$GTSCHT($PIECE(ND0,U,7))_"^"_$PIECE(ND0,U,7)
- +20 SET ^TMP("PS",$JOB,"SIG",0)=INST]""
- if INST]""
- SET ^TMP("PS",$JOB,"SIG",1,0)=INST
- +21 SET ^TMP("PS",$JOB,"ADM",0)=$PIECE(ND2,U,5)]""
- if $PIECE(ND2,U,5)]""
- SET ^TMP("PS",$JOB,"ADM",1,0)=$PIECE(ND2,U,5)
- +22 ;*315
- SET ^TMP("PS",$JOB,"RMV",0)=$PIECE(ND2P1,U,2)]""
- if $PIECE(ND2P1,U,2)]""
- SET ^TMP("PS",$JOB,"RMV",1,0)=$PIECE(ND2P1,U,2)
- +23 SET ^TMP("PS",$JOB,"SIO",0)=ND6]""
- if ND6]""
- SET ^TMP("PS",$JOB,"SIO",1,0)=ND6
- +24 ;*399-IND
- SET IND=$PIECE($GET(@(F_+ON_",18)")),"^")
- +25 IF IND]""
- SET ^TMP("PS",$JOB,"IND",0)=1
- SET ^TMP("PS",$JOB,"IND",1,0)=IND
- +26 NEW VERPHARM
- if ON["U"
- SET VERPHARM=$PIECE($GET(@(F_+ON_",4)")),U,3)
- +27 if +$GET(VERPHARM)
- SET $PIECE(^TMP("PS",$JOB,"RXN",0),U,5)=VERPHARM
- +28 NEW PSJDD,INACTDT,NDDD,OUTOI,PSJOUT
- SET CNT=0
- +29 FOR PSJDD=0:0
- SET PSJDD=$ORDER(@(F_+ON_",1,PSJDD)"))
- if 'PSJDD
- QUIT
- Begin DoDot:1
- +30 SET NDDD=@(F_+ON_",1,PSJDD,0)")
- +31 IF $PIECE(NDDD,U,3)]""
- IF ($PIECE(NDDD,U,3)'>DT)
- QUIT
- +32 SET PSJOUT=$PIECE($GET(^PSDRUG(+NDDD,8)),U,5)
- +33 IF +PSJOUT
- Begin DoDot:2
- +34 SET INACTDT=$GET(^PSDRUG(+PSJOUT,"I"))
- SET OUTOI=+$GET(^PSDRUG(+PSJOUT,2))
- +35 IF INACTDT]""
- IF (INACTDT'>DT)
- SET (PSJOUT,OUTOI)=""
- End DoDot:2
- +36 IF '+PSJOUT
- IF ($PIECE($GET(^PSDRUG(+NDDD,2)),U,3)["O")
- Begin DoDot:2
- +37 SET PSJOUT=+NDDD
- SET OUTOI=+NDOI
- +38 SET INACTDT=$GET(^PSDRUG(+NDDD,"I"))
- +39 IF INACTDT]""
- IF (INACTDT'>DT)
- SET (PSJOUT,OUTOI)=""
- End DoDot:2
- +40 SET UNITS=$PIECE(NDDD,U,2)
- if (ON["U")&(UNITS="")
- SET UNITS=1
- +41 SET CNT=CNT+1
- SET ^TMP("PS",$JOB,"DD",CNT,0)=+NDDD_U_UNITS_U_PSJOUT_U_$GET(OUTOI)
- End DoDot:1
- +42 SET ^TMP("PS",$JOB,"DD",0)=CNT
- +43 QUIT
- +44 ;
- IVTMP ;*** Set ^TMP for IV orders.
- +1 NEW PROVIDER,RNWDT,IVLIM
- SET ND0=$GET(@(F_+ON_",0)"))
- SET CNT=0
- +2 FOR X=0:0
- SET X=$ORDER(@(F_+ON_",""AD"","_X_")"))
- if 'X
- QUIT
- SET ND=$GET(@(F_+ON_",""AD"","_X_",0)"))
- SET DN=$PIECE($GET(^PS(52.6,+ND,0)),U)
- SET Y=DN_U_$PIECE(ND,U,2)
- if $PIECE(ND,U,3)
- SET Y=Y_U_$PIECE(ND,U,3)
- SET CNT=CNT+1
- SET ^TMP("PS",$JOB,"A",CNT,0)=Y
- +3 SET RNWDT=$$LASTREN^PSJLMPRI(DFN,ON)
- IF RNWDT
- SET RNWDT=+RNWDT
- +4 SET ^TMP("PS",$JOB,"A",0)=CNT
- SET CNT=0
- +5 FOR X=0:0
- SET X=$ORDER(@(F_+ON_",""SOL"","_X_")"))
- if 'X
- QUIT
- SET ND=$GET(@(F_+ON_",""SOL"","_X_",0)"))
- SET DN=$GET(^PS(52.7,+ND,0))
- SET CNT=CNT+1
- SET ^TMP("PS",$JOB,"B",CNT,0)=$PIECE(DN,U)_U_$PIECE(ND,U,2)_U_$PIECE(DN,U,4)
- +6 SET ^TMP("PS",$JOB,"B",0)=CNT
- +7 SET INST=$GET(@(F_+ON_",.3)"))
- +8 IF ON["P"
- Begin DoDot:1
- +9 SET SCH=$PIECE($GET(^PS(53.1,+ON,2)),U)
- +10 SET PROVIDER=$PIECE(ND0,U,2)
- +11 SET MR=$$MR(+$PIECE(ND0,U,3))
- SET STAT=$$CODES^PSIVUTL($PIECE(ND0,U,9),53.1,28)
- +12 SET INFUS=$PIECE($GET(^PS(53.1,+ON,8)),U,5)
- +13 SET ND2=$GET(@(F_+ON_",2)"))
- SET START=$PIECE(ND2,U,2)
- SET STOP=$PIECE(ND2,U,4)
- +14 SET ADM=$PIECE(ND2,U,5)
- SET SIO=$PIECE($GET(@(F_+ON_",6)")),"^")
- +15 if ($GET(SIO)["Instructions too long. See Order View or BCMA for full text")
- SET SIO="Instructions too long. See order details for full text."
- +16 SET ND2P5=$GET(@(F_+ON_",2.5)"))
- SET IVLIM=$PIECE(ND2P5,U,4)
- IF $EXTRACT(IVLIM)="a"
- SET IVLIM="doses"_$PIECE(IVLIM,"a",2)
- +17 IF IVLIM=""
- SET IVLIM=$PIECE(ND2P5,U,2)
- if (IVLIM'["d")&(IVLIM'["h")
- SET IVLIM=""
- End DoDot:1
- +18 IF ON'["P"
- Begin DoDot:1
- +19 SET PROVIDER=$PIECE(ND0,U,6)
- +20 SET SCH=$PIECE(ND0,U,9)
- SET INFUS=$PIECE(ND0,U,8)
- SET STAT=$$CODES^PSIVUTL($PIECE(ND0,U,17),55.01,100)
- +21 SET MR=$$MR(+$PIECE($GET(^PS(55,DFN,"IV",+ON,.2)),U,3))
- +22 SET START=$PIECE(ND0,U,2)
- SET STOP=$PIECE(ND0,U,3)
- +23 SET ADM=$PIECE(ND0,U,11)
- SET SIO=$PIECE($GET(@(F_+ON_",3)")),"^")
- +24 if ($GET(SIO)["Instructions too long. See Order View or BCMA for full text")
- SET SIO="Instructions too long. See order details for full text."
- +25 NEW VERPHARM
- SET VERPHARM=$PIECE($GET(^PS(55,DFN,"IV",+ON,4)),U,4)
- +26 if +VERPHARM
- SET $PIECE(^TMP("PS",$JOB,"RXN",0),U,5)=VERPHARM
- +27 SET ND2P5=$GET(@(F_+ON_",2.5)"))
- SET IVLIM=$PIECE(ND2P5,U,4)
- IF IVLIM=""
- SET IVLIM=$PIECE(ND2P5,U,2)
- if (IVLIM'["d")&(IVLIM'["h")
- SET IVLIM=""
- End DoDot:1
- +28 SET DN=$GET(@(F_+ON_",.2)"))
- SET DO=$PIECE(DN,U,2)
- +29 SET DN=$SELECT(+$PIECE(DN,U):$$OIDF^PSJLMUT1($PIECE(DN,U)),1:"")
- +30 SET ^TMP("PS",$JOB,0)=DN_U_INFUS_U_STOP_"^^"_START_U_STAT_"^^^"_DO_"^^"_$PIECE(ND0,U,21)_U_U_U_($PIECE(ND0,U,9)="P"&($PIECE(ND0,U,24)="R"))_U_U_$GET(RNWDT)
- +31 IF PROVIDER
- SET ^TMP("PS",$JOB,"P",0)=PROVIDER_"^"_$PIECE($GET(^VA(200,PROVIDER,0)),"^")
- +32 SET ^TMP("PS",$JOB,"MDR",0)=MR]""
- if MR]""
- SET ^TMP("PS",$JOB,"MDR",1,0)=MR
- +33 SET ^TMP("PS",$JOB,"SCH",0)=SCH]""
- if SCH]""
- SET ^TMP("PS",$JOB,"SCH",1,0)=SCH
- +34 IF ON["P"
- if $PIECE(ND0,U,7)]""
- SET ^TMP("PS",$JOB,"SCH",0)=1
- SET $PIECE(^TMP("PS",$JOB,"SCH",1,0),U,2)=$$GTSCHT($PIECE(ND0,U,7))_"^"_$PIECE(ND0,U,7)
- +35 SET ^TMP("PS",$JOB,"SIG",0)=INST]""
- if INST]""
- SET ^TMP("PS",$JOB,"SIG",1,0)=INST
- +36 SET ^TMP("PS",$JOB,"ADM",0)=ADM]""
- if ADM]""
- SET ^TMP("PS",$JOB,"ADM",1,0)=ADM
- +37 SET ^TMP("PS",$JOB,"SIO",0)=SIO]""
- if SIO]""
- SET ^TMP("PS",$JOB,"SIO",1,0)=SIO
- +38 IF $GET(IVLIM)]""
- SET ^TMP("PS",$JOB,"IVLIM",0)=$GET(IVLIM)
- +39 ;*399-IND
- SET IND=$PIECE($GET(@(F_+ON_",18)")),"^")
- +40 IF IND]""
- SET ^TMP("PS",$JOB,"IND",0)=1
- SET ^TMP("PS",$JOB,"IND",1,0)=IND
- +41 QUIT
- +42 ;
- MR(X) ;RETURN MED ROUTE ABBR. IF THE ABBR="" RETURN MED ROUTE'S NAME.
- +1 SET X=$GET(^PS(51.2,X,0))
- +2 QUIT $SELECT($PIECE(X,U,3)]"":$PIECE(X,U,3),1:$PIECE(X,U))
- +3 ;
- GTSTAT(X) ;
- +1 QUIT $SELECT(X="A":"ACTIVE",X="D":"DISCONTINUED",X="I":"INCOMPLETE",X="N":"NON-VERFIED",X="U":"UNRELEASED",X="P":"PENDING",X="DE":"DISCONTINUED (EDIT)",X="O":"ON CALL",1:"NOT FOUND")
- +2 ;
- VA200(X) ;Return the IEN for the user.
- +1 ; X = User name
- +2 NEW DIC,Y
- SET DIC="^VA(200,"
- SET DIC(0)="NZ"
- DO ^DIC
- +3 IF +Y=-1
- QUIT ""
- +4 QUIT $PIECE(Y,U)
- GTSCHT(X) ;
- +1 QUIT $SELECT(X="C":"CONTINUOUS",X="O":"ONE TIME",X="P":"PRN",X="R":"FILL ON REQUEST",X="OC":"ON CALL",1:"NOT FOUND")