PSJPXRM1 ;BIR/MV - RETURN INPATIENT ACTIVE MEDS (EXPANDED) ;Apr 20, 2021@15:09:49
;;5.0;INPATIENT MEDICATIONS;**90,170,225,399**;16 DEC 97;Build 64
;
; 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 ^VA(200 is supported by DBIA 10060.
; Reference to ^DIC is supported by DBIA 10006.
;
OEL(DAS,NAME) ; return list of expanded inpat meds
N ADM,CNT,DFN,DN,DO,F,INFUS,INST,MR,ND,ND0,ND2,ND6,NDOI,ON,SCH,SIO,START,STAT,STOP,TYP,UNITS,X,Y
S DFN=$P(DAS,";")
S F=$S($P(DAS,";",2)["P":"^PS(53.1,",$P(DAS,";",2)=5:"^PS(55,DFN,5,",1:"^PS(55,"_DFN_",""IV"",")
S ON=$P(DAS,";",3)_$S($P(DAS,";",2)="IV":"V",$P(DAS,";",2)=5:"U",1:"P")
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")
D:ON'["P" @$S(ON["U":"UDTMP",1:"IVTMP")
S NAME("INDICATION")=$P($G(@(F_+ON_",18)")),U)
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)")),NAME("PC",CNT,0)=ND
S NAME("PC",0)=CNT
Q
;
UDTMP ;*** Set array for Unit dose orders.
N DO,DN,INST,X,Y,PROVIDER,NOTGIVEN
S (MR,SCH,INST)=""
S ND2=$G(@(F_+ON_",2)")),ND0=$G(@(F_+ON_",0)"))
S ND6=$P($G(@(F_+ON_",6)")),"^")
S NAME("STAT")=$$CODES^PSIVUTL($P(ND0,U,9),$S(ON["P":53.1,1:55.06),28)
D DRGDISP^PSJLMUT1(DFN,ON,40,0,.DN,1)
S NDOI=$G(@(F_+ON_",.2)")),NAME("OI")=+NDOI,NAME("DO")=$P(NDOI,U,2)
S NAME("START")=$P(ND2,"^",2),NAME("STOP")=$P(ND2,"^",4)
S NAME("UNITS")="" I '$O(@(F_+ON_",1,1)")) S NAME("UNITS")=$P($G(@(F_+ON_",1,1,0)")),U,2) S:(ON["U")&(NAME("UNITS")="") NAME("UNITS")=1
S NAME("MR")=$$MR(+$P(ND0,U,3)),NAME("INST")=$G(@(F_+ON_",.3)"))
S NAME("NOTGIVEN")=$S(ON["U":$P($G(^PS(55,DFN,5,+ON,0)),"^",22),1:"")
S NAME("OERR")=$P(ND0,U,21)
S NAME("PENDRENEWAL")=($P(ND0,U,9)="P"&($P(ND0,U,24)="R"))
S NAME("PROVIDER")=$P($G(@(F_+ON_",0)")),"^",2)
I NAME("PROVIDER") S NAME("PROVIDER")=NAME("PROVIDER")_"^"_$P($G(^VA(200,NAME("PROVIDER"),0)),"^")
S NAME("MDR",0)=NAME("MR")]"" S:NAME("MR")]"" NAME("MDR",1,0)=NAME("MR")
S NAME("SCH",0)=$P(ND2,U)]"" S:$P(ND2,U)]"" NAME("SCH",1,0)=$P(ND2,U)
S:$P(ND0,U,7)]"" NAME("SCH",0)=1,$P(NAME("SCH",1,0),U,2)=$$GTSCHT($P(ND0,U,7))_"^"_$P(ND0,U,7)
S NAME("SIG",0)=INST]"" S:INST]"" NAME("SIG",1,0)=INST
S NAME("ADM",0)=$P(ND2,U,5)]"" S:$P(ND2,U,5)]"" NAME("ADM",1,0)=$P(ND2,U,5)
S NAME("SIO",0)=ND6]"" S:ND6]"" NAME("SIO",1,0)=ND6
S:ON["U" NAME("VERPHARM")=$P($G(@(F_+ON_",4)")),U,3)
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=$S('+$P(NDDD,U,2):1,1:$P(NDDD,U,2))
. ;*225 Don't allow 0 Units
. S UNITS=$P(NDDD,U,2) S:(ON["U")&(+UNITS=0) UNITS=1
. S CNT=CNT+1,NAME("DD",CNT,0)=+NDDD_U_UNITS_U_PSJOUT_U_$G(OUTOI)
S NAME("DD",0)=CNT
Q
;
IVTMP ;*** Set array for IV orders.
N PROVIDER 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,NAME("AD",CNT,0)=Y
S NAME("AD",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,NAME("SOL",CNT,0)=$P(DN,U)_U_$P(ND,U,2)_U_$P(DN,U,4)
S NAME("SOL",0)=CNT
S NAME("INST")=$G(@(F_+ON_",.3)"))
I ON["P" D
. S NAME("SCH")=$P($G(^PS(53.1,+ON,2)),U)
. S NAME("PROVIDER")=$P(ND0,U,2)
. S NAME("MR")=$$MR(+$P(ND0,U,3)),NAME("STAT")=$$CODES^PSIVUTL($P(ND0,U,9),53.1,28)
. S NAME("INFUS")=$P($G(^PS(53.1,+ON,8)),U,5)
. S ND2=$G(@(F_+ON_",2)")),NAME("START")=$P(ND2,U,2),NAME("STOP")=$P(ND2,U,4)
. S NAME("ADM")=$P(ND2,U,5),NAME("SIO")=$P($G(@(F_+ON_",6)")),"^")
. S NAME("DN")=$G(@(F_+ON_",.2)")),NAME("DO")=$P(NAME("DN"),U,2)
. S:NAME("DO")="" NAME("DO")=$P($G(NAME("AD",1,0)),U,2)
. S NAME("DN")=$S(+$P(NAME("DN"),U):$$OIDF^PSJLMUT1($P(NAME("DN"),U)),1:"")
I ON'["P" D
. S NAME("PROVIDER")=$P(ND0,U,6)
. S NAME("SCH")=$P(ND0,U,9),NAME("INFUS")=$P(ND0,U,8),NAME("STAT")=$$CODES^PSIVUTL($P(ND0,U,17),55.01,100)
. S NAME("MR")=$$MR(+$P($G(^PS(55,DFN,"IV",+ON,.2)),U,3))
. S NAME("START")=$P(ND0,U,2),NAME("STOP")=$P(ND0,U,3)
. S NAME("ADM")=$P(ND0,U,11),NAME("SIO")=$P($G(@(F_+ON_",3)")),"^")
. S NAME("VERPHARM")=$P($G(^PS(55,DFN,"IV",+ON,4)),U,4)
. S NAME("DN")=$G(@(F_+ON_",.2)")),NAME("DO")=$P(NAME("DN"),U,2)
. S NAME("DN")=$S(+$P(NAME("DN"),U):$$OIDF^PSJLMUT1($P(NAME("DN"),U)),1:"")
S NAME("OERR")=$P(ND0,U,21)
S NAME("PENDRENEWAL")=($P(ND0,U,9)="P"&($P(ND0,U,24)="R"))
I NAME("PROVIDER") S NAME("PROVIDER")=NAME("PROVIDER")_"^"_$P($G(^VA(200,NAME("PROVIDER"),0)),"^")
S NAME("MDR",0)=NAME("MR")]"" S:NAME("MR")]"" NAME("MDR",1,0)=NAME("MR")
S NAME("SCH",0)=NAME("SCH")]"" S:NAME("SCH")]"" NAME("SCH",1,0)=NAME("SCH")
I ON["P" S:$P(ND0,U,7)]"" NAME("SCH",0)=1,$P(NAME("SCH",1,0),U,2)=$$GTSCHT($P(ND0,U,7))_"^"_$P(ND0,U,7)
S NAME("SIG",0)=NAME("INST")]"" S:NAME("INST")]"" NAME("SIG",1,0)=NAME("INST")
S NAME("ADM",0)=NAME("ADM")]"" S:NAME("ADM")]"" NAME("ADM",1,0)=NAME("ADM")
S NAME("SIO",0)=NAME("SIO")]"" S:NAME("SIO")]"" NAME("SIO",1,0)=NAME("SIO")
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[HPSJPXRM1 6477 printed Sep 23, 2025@19:45:07 Page 2
PSJPXRM1 ;BIR/MV - RETURN INPATIENT ACTIVE MEDS (EXPANDED) ;Apr 20, 2021@15:09:49
+1 ;;5.0;INPATIENT MEDICATIONS;**90,170,225,399**;16 DEC 97;Build 64
+2 ;
+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 ^VA(200 is supported by DBIA 10060.
+9 ; Reference to ^DIC is supported by DBIA 10006.
+10 ;
OEL(DAS,NAME) ; return list of expanded inpat meds
+1 NEW ADM,CNT,DFN,DN,DO,F,INFUS,INST,MR,ND,ND0,ND2,ND6,NDOI,ON,SCH,SIO,START,STAT,STOP,TYP,UNITS,X,Y
+2 SET DFN=$PIECE(DAS,";")
+3 SET F=$SELECT($PIECE(DAS,";",2)["P":"^PS(53.1,",$PIECE(DAS,";",2)=5:"^PS(55,DFN,5,",1:"^PS(55,"_DFN_",""IV"",")
+4 SET ON=$PIECE(DAS,";",3)_$SELECT($PIECE(DAS,";",2)="IV":"V",$PIECE(DAS,";",2)=5:"U",1:"P")
+5 IF ON'["P"
IF '$DATA(@(F_+ON_")"))
QUIT
+6 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")
+7 if ON'["P"
DO @$SELECT(ON["U":"UDTMP",1:"IVTMP")
+8 SET NAME("INDICATION")=$PIECE($GET(@(F_+ON_",18)")),U)
+9 SET Y=$SELECT(ON["V":5,1:12)
SET CNT=0
+10 IF $ORDER(@(F_+ON_","_Y_",0)"))
Begin DoDot:1
+11 FOR X=0:0
SET X=$ORDER(@(F_+ON_","_Y_","_X_")"))
if 'X
QUIT
Begin DoDot:2
+12 SET CNT=CNT+1
SET ND=$GET(@(F_+ON_","_Y_","_X_",0)"))
SET NAME("PC",CNT,0)=ND
End DoDot:2
End DoDot:1
+13 SET NAME("PC",0)=CNT
+14 QUIT
+15 ;
UDTMP ;*** Set array for Unit dose orders.
+1 NEW DO,DN,INST,X,Y,PROVIDER,NOTGIVEN
+2 SET (MR,SCH,INST)=""
+3 SET ND2=$GET(@(F_+ON_",2)"))
SET ND0=$GET(@(F_+ON_",0)"))
+4 SET ND6=$PIECE($GET(@(F_+ON_",6)")),"^")
+5 SET NAME("STAT")=$$CODES^PSIVUTL($PIECE(ND0,U,9),$SELECT(ON["P":53.1,1:55.06),28)
+6 DO DRGDISP^PSJLMUT1(DFN,ON,40,0,.DN,1)
+7 SET NDOI=$GET(@(F_+ON_",.2)"))
SET NAME("OI")=+NDOI
SET NAME("DO")=$PIECE(NDOI,U,2)
+8 SET NAME("START")=$PIECE(ND2,"^",2)
SET NAME("STOP")=$PIECE(ND2,"^",4)
+9 SET NAME("UNITS")=""
IF '$ORDER(@(F_+ON_",1,1)"))
SET NAME("UNITS")=$PIECE($GET(@(F_+ON_",1,1,0)")),U,2)
if (ON["U")&(NAME("UNITS")="")
SET NAME("UNITS")=1
+10 SET NAME("MR")=$$MR(+$PIECE(ND0,U,3))
SET NAME("INST")=$GET(@(F_+ON_",.3)"))
+11 SET NAME("NOTGIVEN")=$SELECT(ON["U":$PIECE($GET(^PS(55,DFN,5,+ON,0)),"^",22),1:"")
+12 SET NAME("OERR")=$PIECE(ND0,U,21)
+13 SET NAME("PENDRENEWAL")=($PIECE(ND0,U,9)="P"&($PIECE(ND0,U,24)="R"))
+14 SET NAME("PROVIDER")=$PIECE($GET(@(F_+ON_",0)")),"^",2)
+15 IF NAME("PROVIDER")
SET NAME("PROVIDER")=NAME("PROVIDER")_"^"_$PIECE($GET(^VA(200,NAME("PROVIDER"),0)),"^")
+16 SET NAME("MDR",0)=NAME("MR")]""
if NAME("MR")]""
SET NAME("MDR",1,0)=NAME("MR")
+17 SET NAME("SCH",0)=$PIECE(ND2,U)]""
if $PIECE(ND2,U)]""
SET NAME("SCH",1,0)=$PIECE(ND2,U)
+18 if $PIECE(ND0,U,7)]""
SET NAME("SCH",0)=1
SET $PIECE(NAME("SCH",1,0),U,2)=$$GTSCHT($PIECE(ND0,U,7))_"^"_$PIECE(ND0,U,7)
+19 SET NAME("SIG",0)=INST]""
if INST]""
SET NAME("SIG",1,0)=INST
+20 SET NAME("ADM",0)=$PIECE(ND2,U,5)]""
if $PIECE(ND2,U,5)]""
SET NAME("ADM",1,0)=$PIECE(ND2,U,5)
+21 SET NAME("SIO",0)=ND6]""
if ND6]""
SET NAME("SIO",1,0)=ND6
+22 if ON["U"
SET NAME("VERPHARM")=$PIECE($GET(@(F_+ON_",4)")),U,3)
+23 NEW PSJDD,INACTDT,NDDD,OUTOI,PSJOUT
SET CNT=0
+24 FOR PSJDD=0:0
SET PSJDD=$ORDER(@(F_+ON_",1,PSJDD)"))
if 'PSJDD
QUIT
Begin DoDot:1
+25 SET NDDD=@(F_+ON_",1,PSJDD,0)")
+26 IF $PIECE(NDDD,U,3)]""
IF ($PIECE(NDDD,U,3)'>DT)
QUIT
+27 SET PSJOUT=$PIECE($GET(^PSDRUG(+NDDD,8)),U,5)
+28 IF +PSJOUT
Begin DoDot:2
+29 SET INACTDT=$GET(^PSDRUG(+PSJOUT,"I"))
SET OUTOI=+$GET(^PSDRUG(+PSJOUT,2))
+30 IF INACTDT]""
IF (INACTDT'>DT)
SET (PSJOUT,OUTOI)=""
End DoDot:2
+31 IF '+PSJOUT
IF ($PIECE($GET(^PSDRUG(+NDDD,2)),U,3)["O")
Begin DoDot:2
+32 SET PSJOUT=+NDDD
SET OUTOI=+NDOI
+33 SET INACTDT=$GET(^PSDRUG(+NDDD,"I"))
+34 IF INACTDT]""
IF (INACTDT'>DT)
SET (PSJOUT,OUTOI)=""
End DoDot:2
+35 ;* S UNITS=$S('+$P(NDDD,U,2):1,1:$P(NDDD,U,2))
+36 ;*225 Don't allow 0 Units
+37 SET UNITS=$PIECE(NDDD,U,2)
if (ON["U")&(+UNITS=0)
SET UNITS=1
+38 SET CNT=CNT+1
SET NAME("DD",CNT,0)=+NDDD_U_UNITS_U_PSJOUT_U_$GET(OUTOI)
End DoDot:1
+39 SET NAME("DD",0)=CNT
+40 QUIT
+41 ;
IVTMP ;*** Set array for IV orders.
+1 NEW PROVIDER
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 NAME("AD",CNT,0)=Y
+3 SET NAME("AD",0)=CNT
SET CNT=0
+4 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 NAME("SOL",CNT,0)=$PIECE(DN,U)_U_$PIECE(ND,U,2)_U_$PIECE(DN,U,4)
+5 SET NAME("SOL",0)=CNT
+6 SET NAME("INST")=$GET(@(F_+ON_",.3)"))
+7 IF ON["P"
Begin DoDot:1
+8 SET NAME("SCH")=$PIECE($GET(^PS(53.1,+ON,2)),U)
+9 SET NAME("PROVIDER")=$PIECE(ND0,U,2)
+10 SET NAME("MR")=$$MR(+$PIECE(ND0,U,3))
SET NAME("STAT")=$$CODES^PSIVUTL($PIECE(ND0,U,9),53.1,28)
+11 SET NAME("INFUS")=$PIECE($GET(^PS(53.1,+ON,8)),U,5)
+12 SET ND2=$GET(@(F_+ON_",2)"))
SET NAME("START")=$PIECE(ND2,U,2)
SET NAME("STOP")=$PIECE(ND2,U,4)
+13 SET NAME("ADM")=$PIECE(ND2,U,5)
SET NAME("SIO")=$PIECE($GET(@(F_+ON_",6)")),"^")
+14 SET NAME("DN")=$GET(@(F_+ON_",.2)"))
SET NAME("DO")=$PIECE(NAME("DN"),U,2)
+15 if NAME("DO")=""
SET NAME("DO")=$PIECE($GET(NAME("AD",1,0)),U,2)
+16 SET NAME("DN")=$SELECT(+$PIECE(NAME("DN"),U):$$OIDF^PSJLMUT1($PIECE(NAME("DN"),U)),1:"")
End DoDot:1
+17 IF ON'["P"
Begin DoDot:1
+18 SET NAME("PROVIDER")=$PIECE(ND0,U,6)
+19 SET NAME("SCH")=$PIECE(ND0,U,9)
SET NAME("INFUS")=$PIECE(ND0,U,8)
SET NAME("STAT")=$$CODES^PSIVUTL($PIECE(ND0,U,17),55.01,100)
+20 SET NAME("MR")=$$MR(+$PIECE($GET(^PS(55,DFN,"IV",+ON,.2)),U,3))
+21 SET NAME("START")=$PIECE(ND0,U,2)
SET NAME("STOP")=$PIECE(ND0,U,3)
+22 SET NAME("ADM")=$PIECE(ND0,U,11)
SET NAME("SIO")=$PIECE($GET(@(F_+ON_",3)")),"^")
+23 SET NAME("VERPHARM")=$PIECE($GET(^PS(55,DFN,"IV",+ON,4)),U,4)
+24 SET NAME("DN")=$GET(@(F_+ON_",.2)"))
SET NAME("DO")=$PIECE(NAME("DN"),U,2)
+25 SET NAME("DN")=$SELECT(+$PIECE(NAME("DN"),U):$$OIDF^PSJLMUT1($PIECE(NAME("DN"),U)),1:"")
End DoDot:1
+26 SET NAME("OERR")=$PIECE(ND0,U,21)
+27 SET NAME("PENDRENEWAL")=($PIECE(ND0,U,9)="P"&($PIECE(ND0,U,24)="R"))
+28 IF NAME("PROVIDER")
SET NAME("PROVIDER")=NAME("PROVIDER")_"^"_$PIECE($GET(^VA(200,NAME("PROVIDER"),0)),"^")
+29 SET NAME("MDR",0)=NAME("MR")]""
if NAME("MR")]""
SET NAME("MDR",1,0)=NAME("MR")
+30 SET NAME("SCH",0)=NAME("SCH")]""
if NAME("SCH")]""
SET NAME("SCH",1,0)=NAME("SCH")
+31 IF ON["P"
if $PIECE(ND0,U,7)]""
SET NAME("SCH",0)=1
SET $PIECE(NAME("SCH",1,0),U,2)=$$GTSCHT($PIECE(ND0,U,7))_"^"_$PIECE(ND0,U,7)
+32 SET NAME("SIG",0)=NAME("INST")]""
if NAME("INST")]""
SET NAME("SIG",1,0)=NAME("INST")
+33 SET NAME("ADM",0)=NAME("ADM")]""
if NAME("ADM")]""
SET NAME("ADM",1,0)=NAME("ADM")
+34 SET NAME("SIO",0)=NAME("SIO")]""
if NAME("SIO")]""
SET NAME("SIO",1,0)=NAME("SIO")
+35 QUIT
+36 ;
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")
