PSJBCMA1 ;BIR/MV-RETURN INFORMATION FOR AN ORDER ;16 Mar 99 / 10:59 AM
;;5.0; INPATIENT MEDICATIONS ;**32,41,46,57,63,66,56,58,81,91,104,186,159,173**;16 DEC 97;Build 4
;
; Reference to ^PS(50.7 is supported by DBIA 2180.
; 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 ^DIC is supported by DBIA 10006.
; Reference to ^DIQ is supported by DBIA 2056.
; Usage of this routine by BCMA is supported by DBIA 2829.
;
EN(DFN,ON,PSJTMP) ; return detail data for Inpatient Meds.
NEW F,A
S PSJTMP=$S($G(PSJTMP)=1:"PSJ1",1:"PSJ")
I $G(ON)["U" S F="^PS(55,+$G(DFN),5,+ON" D:$D(@(F_")")) UDVAR
I $G(ON)["V" S F="^PS(55,+$G(DFN),""IV"",+ON" D:$D(@(F_")")) IVVAR
I $G(ON)["P" S F="^PS(53.1,+ON",X=$P($G(^PS(53.1,+ON,0)),U,4) D:$D(@(F_")")) @$S(X="F":"IVVAR",1:"UDVAR")
I '$D(^TMP(PSJTMP,$J,0)) S ^(0)=-1
Q
;
UDVAR ;* Set ^TMP for Unit dose & Pending orders
NEW CNT,X
D UDPEND
D TMP
;* Setup Dispense drug for ^TMP
S CNT=0 D NOW^%DTC
F X=0:0 S X=$O(@(F_",1,"_X_")")) Q:'X D
. S PSJDD=@(F_",1,"_X_",0)") I $P(PSJDD,"^",3)]"",$P(PSJDD,"^",3)'>% Q
. S CNT=CNT+1
. S ^TMP(PSJTMP,$J,700,CNT,0)=+PSJDD_U_$P($G(^PSDRUG(+PSJDD,0)),U)_U_$S((ON["U")&($P(PSJDD,U,2)=""):1,(ON["U")&($E($P(PSJDD,U,2))="."):"0"_$P(PSJDD,U,2),1:$P(PSJDD,U,2))_U_$P(PSJDD,U,3)
S:CNT ^TMP(PSJTMP,$J,700,0)=CNT
K PSJ,PSJDD,PSJDN
Q
IVVAR ;* Set variables for IV and pending orders
NEW CNT,DN,ND,X,Y
I ON["P" D UDPEND S PSJ("INFRATE")=$P($G(^PS(53.1,ON,8)),U,5)
I ON["V" D
. S X=$G(^PS(55,DFN,"IV",+ON,0))
. S PSJ("STARTDT")=$P(X,U,2),PSJ("STOPDT")=$P(X,U,3)
. S PSJ("PROVIDER")=$P(X,U,6)
. S PSJ("INFRATE")=$P(X,U,8),PSJ("SCHD")=$P(X,U,9)
. S PSJ("ADM")=$P(X,U,11),PSJ("AUTO")=$P(X,U,12),PSJ("STATUS")=$P(X,U,17)
. S PSJ("FREQ")=$P(X,U,15),PSJ("IVTYPE")=$P(X,U,4)
. S PSJ("INSYR")=$P(X,U,5),PSJ("CPRS")=$P(X,U,21),PSJ("CHEMO")=$P(X,U,23)
. S X=$G(^PS(55,DFN,"IV",+ON,.2))
. S PSJ("OI")=$P(X,U),PSJ("DO")="",PSJ("PRI")=$P(X,U,4),PSJ("FLG")=$P(X,U,7),PSJ("COM")="",PSJ("SRC")=""
. I PSJ("FLG") D
.. N S1,A,B,C
.. S S1="" F S S1=$O(^PS(55,DFN,"IV",+ON,"A",S1),-1) Q:'S1 S C=$G(^(S1,0)) S A=$P(C,U,2),B=$P(C,U,4) Q:A="UG" D I PSJ("SRC")]"" Q
... Q:A'="G"
... S PSJ("SRC")=$S(B["FLAGGED BY PHARM":"PHARMACIST",B["FLAGGED BY CPRS":"CPRS",1:"")
... S PSJ("COM")=$P(B," ",4,99)
. S PSJ("MR")=$P(X,U,3)
. S X=$G(^PS(55,DFN,"IV",+ON,4))
. S PSJ("NURSE")=$P(X,U)
. S PSJ("PHARM")=$P(X,U,4)
. S X=$G(^PS(55,DFN,"IV",+ON,2))
. S PSJ("LDT")=$P(X,U)
. S PSJ("PREV")=$P(X,U,5),PSJ("FOLLOW")=$P(X,U,6)
. S PSJ("SIOPI")=$S($P($G(^PS(55,DFN,"IV",+ON,3)),"^",2)&($P($G(^PS(55,DFN,"IV",+ON,3)),"^")'=""):"!",1:"")_$P($G(^(3)),"^")
. N SCHD S SCHD=PSJ("SCHD") ; SCHD var required to shorten $Select
. S PSJ("STC")=$$ONE^PSJBCMA(DFN,ON,SCHD,PSJ("STARTDT"),PSJ("STOPDT"))
. I PSJ("STC")=""!(PSJ("STC")="C") S PSJ("STC")=$S(SCHD["PRN":"P",1:"C")
. I PSJ("STC")="C" S PSJ("STC")=$S(SCHD["ON CALL":"OC",SCHD["ON-CALL":"OC",SCHD["ONCALL":"OC",1:"C")
. S PSJ("NURSE")=$P($G(^PS(55,DFN,"IV",+ON,4)),U)
D TMP
S X=$P($G(^PS(55,DFN,"IV",+ON,1)),U) S:X]"" ^TMP(PSJTMP,$J,6)=X
S CNT=0
F X=0:0 S X=$O(@(F_",""AD"","_X_")")) Q:'X D
. S ND=$G(@(F_",""AD"","_X_",0)")),DN=$G(^PS(52.6,+ND,0)) ;,AOINAME=$$OIDF^PSJLMUT1(+$P(DN,U,11)) I AOINAME["NOTFOUND" S AOINAME=""
. ;S AOIDF=$$GET1^DIQ(50.7,+$P(DN,U,11),.02) I AOINAME="" S AOIDF=""
. S CNT=CNT+1,^TMP(PSJTMP,$J,850,CNT,0)=+ND_U_$P(DN,U)_U_$P(ND,U,2)_U_$P(ND,U,3) ;_U_U_$P(DN,U,11)_U_AOINAME_U_AOIDF
S:CNT ^TMP(PSJTMP,$J,850,0)=CNT,CNT=0
F X=0:0 S X=$O(@(F_",""SOL"","_X_")")) Q:'X D
. S ND=$G(@(F_",""SOL"","_X_",0)")),DN=$G(^PS(52.7,+ND,0)) ;,SOINAME=$$OIDF^PSJLMUT1(+$P(DN,U,11)) I SOINAME["NOTFOUND" S SOINAME=""
. ;S SOIDF=$$GET1^DIQ(50.7,+$P(DN,U,11),.02) I SOINAME="" S SOIDF=""
. S CNT=CNT+1,^TMP(PSJTMP,$J,950,CNT,0)=+ND_U_$P(DN,U)_U_$P(ND,U,2)_U_$P(DN,U,4) ;_U_U_$P(DN,U,11)_U_SOINAME_U_SOIDF
S:CNT ^TMP(PSJTMP,$J,950,0)=CNT
K PSJ
S X1=0
F S X1=$O(^PS(55,DFN,"IVBCMA",X1)) Q:'X1 D
. S XX=$G(^PS(55,DFN,"IVBCMA",X1,0)) Q:$P(XX,"^",2)'=+ON S PSJBCID=$P(XX,"^"),X2=0
. F I=1:1 S X2=$O(^PS(55,DFN,"IVBCMA",X1,"AD",X2)) Q:'X2 S X=^(X2,0),^TMP(PSJTMP,$J,800,PSJBCID,I)=+X_"^"_$S($D(^PS(52.6,+X,0)):$P(^(0),"^"),1:"*****")_"^"_$P(X,"^",2,99)
. I I>1 S ^TMP(PSJTMP,$J,800,PSJBCID,0)=I-1
. S X2=0
. F I=1:1 S X2=$O(^PS(55,DFN,"IVBCMA",X1,"SOL",X2)) Q:'X2 S X=^(X2,0),^TMP(PSJTMP,$J,900,PSJBCID,I)=$P(X,"^")_"^"_$S($D(^PS(52.7,$P(X,"^"),0)):$P(^(0),"^"),1:"*****")_"^"_$P(X,"^",2,99)
. I I>1 S ^TMP(PSJTMP,$J,900,PSJBCID,0)=I-1
. S ^TMP(PSJTMP,$J,1000,PSJBCID)=$P(XX,"^",6)_"^"_$P(XX,"^",8)_"^"_$P(XX,"^",7)
Q
UDPEND ;
S X=$G(@(F_",0)"))
S PSJ("PROVIDER")=$P(X,U,2)
S PSJ("MR")=$P(X,U,3),PSJ("SM")=$P(X,U,5),PSJ("HSM")=$P(X,U,6)
S PSJ("ST")=$P(X,U,7),PSJ("STATUS")=$P(X,U,9)
S PSJ("LDT")=$P(X,U,16)
S:ON["U" PSJ("NGIVEN")=$P(X,U,22)
S PSJ("SMYN")=$S(+PSJ("SM"):"YES",1:"NO")
S PSJ("HSMYN")=$S(+PSJ("HSM"):"YES",1:"NO")
S PSJ("CPRS")=$P(X,U,21),PSJ("PREV")=$P(X,U,25),PSJ("FOLLOW")=$P(X,U,26)
S X=$G(@(F_",.2)"))
S PSJ("OI")=$P(X,U),PSJ("DO")=$P(X,U,2),PSJ("PRI")=$P(X,U,4),PSJ("FLG")=$P(X,U,7),PSJ("COM")="",PSJ("SRC")=""
I PSJ("FLG") D
. N S1,A,B,C
. S S1="" F S S1=$O(^PS(55,DFN,5,+ON,9,S1),-1) Q:'S1 S C=$G(^(S1,0)) S A=$P(C,U,3),B=$P(C,U,4) Q:A=7010!(A=7030) D I PSJ("SRC")]"" Q
.. Q:A'=7000&(A'=7020)
.. S PSJ("SRC")=$S(A=7000:"PHARMACIST",A=7020:"CPRS",1:"")
.. S PSJ("COM")=$G(@(F_",13)"))
S X=$G(@(F_",2)"))
S PSJ("SCHD")=$P(X,U),PSJ("STARTDT")=$P(X,U,2)
S PSJ("STC")=PSJ("ST")
I PSJ("ST")="R"!(PSJ("ST")="C") S PSJ("STC")=$S(PSJ("SCHD")["PRN":"P","^ONCALL^ON-CALL^ON CALL^"[("^"_PSJ("SCHD")_"^"):"OC",$$ONE^PSJBCMA(DFN,ON,PSJ("SCHD"))="O":"O",1:"C")
I PSJ("STC")="O" S PSJ("ST")="O"
S PSJ("STOPDT")=$P(X,U,4),PSJ("ADM")=$P(X,U,5)
S PSJ("FREQ")=$P(X,U,6)
S X=$G(@(F_",4)"))
S PSJ("NURSE")=$P(X,U),PSJ("AUTO")=$P(X,U,11)
S:ON["U" PSJ("PHARM")=+$P(X,U,3)
; the naked reference on the line below refers to the full reference created by indirect reference to F, where F may refer to ^PS(53.1 or the IV or UD multiple ^PS(55
S PSJ("SIOPI")=$S($P($G(@(F_",6)")),"^",2)&($P($G(@(F_",6)")),"^")'=""):"!",1:"")_$$ENSET^PSJBCMA($P($G(^(6)),"^"))
NEW FON S FON=ON D SIOPI^PSJBCMA
Q
;
TMP ;* Setup ^TMP that have common fields between IV and U/D
D NAME(PSJ("PROVIDER"),.PSJNAME,"","")
S PSJ("PRONAME")=PSJNAME K PSJNAME
I $D(PSJ("PHARM")) D
. D NAME(PSJ("PHARM"),.PSJNAME,.PSJINIT,.PSJPIEN)
. S PSJ("PHARM")=PSJPIEN,PSJ("PNAME")=PSJNAME,PSJ("PINIT")=PSJINIT K PSJNAME,PSJINIT,PSJPIEN
I +PSJ("NURSE") D
. D NAME(PSJ("NURSE"),.PSJNAME,.PSJINIT,"")
. S PSJ("NNAME")=PSJNAME,PSJ("NINIT")=PSJINIT K PSJNAME,PSJINIT
S A=$G(^PS(51.2,+PSJ("MR"),0)),PSJ("MRNM")=$P(A,U),PSJ("MRABB")=$P(A,U,3),PSJ("MRPIJ")=$P(A,U,8),PSJ("MRIVP")=$P(A,U,9)
S PSJ("OINAME")=$$OIDF^PSJLMUT1(+PSJ("OI")) I PSJ("OINAME")["NOT FOUND" S PSJ("OINAME")=""
S PSJ("OIDF")=$$GET1^DIQ(50.7,+PSJ("OI"),.02)
I PSJ("OINAME")="" S PSJ("OIDF")=""
S PSJ("LDTN")=$$DATE(PSJ("LDT"))
S PSJ("STARTDTN")=$$DATE(PSJ("STARTDT"))
S PSJ("STOPDTN")=$$DATE(PSJ("STOPDT"))
S X=$S(ON["V":PSJ("STC"),1:PSJ("ST"))
S PSJ("STNAME")=$S(X="C":"CONTINUOUS",X="O":"ONE TIME",X="P":"PRN",X="R":"FILL ON REQUEST",X="OC":"ON CALL",1:"NOT FOUND")
;
S ^TMP(PSJTMP,$J,0)=DFN_U_+ON_U_ON_U_PSJ("PREV")_U_PSJ("FOLLOW")_U_$G(PSJ("IVTYPE"))_U_$G(PSJ("INSYR"))_U_$G(PSJ("CHEMO"))_U_PSJ("CPRS")
S ^TMP(PSJTMP,$J,1)=PSJ("PROVIDER")_U_PSJ("PRONAME")_U_PSJ("MR")_U_PSJ("MRABB")_U_$G(PSJ("SM"))_U_$G(PSJ("SMYN"))_U_$G(PSJ("HSM"))_U_$G(PSJ("HSMYN"))_U_$G(PSJ("NGIVEN"))_U_PSJ("STATUS")
S ^TMP(PSJTMP,$J,1)=^TMP(PSJTMP,$J,1)_U_$$STATUS(ON,PSJ("STATUS"))_U_$G(PSJ("AUTO"))_U_$G(PSJ("MRNM"))
S ^TMP(PSJTMP,$J,1,0)=PSJ("MRPIJ")_U_$G(PSJ("MRIVP"))
S ^TMP(PSJTMP,$J,2)=PSJ("OI")_U_PSJ("OINAME")_U_PSJ("DO")_U_$G(PSJ("INFRATE"))_U_$G(PSJ("SCHD"))_U_PSJ("OIDF")
S ^TMP(PSJTMP,$J,3)=PSJ("SIOPI")
S ^TMP(PSJTMP,$J,4)=PSJ("STC")_U_$G(PSJ("STNAME"))_U_PSJ("LDT")_U_PSJ("LDTN")_U_PSJ("STARTDT")_U_PSJ("STARTDTN")_U_PSJ("STOPDT")_U_PSJ("STOPDTN")_U_$$ADMIN(PSJ("ADM"))_U_$G(PSJ("ST"))_U_$G(PSJ("FREQ"))
S ^TMP(PSJTMP,$J,5)=$G(PSJ("NURSE"))_U_$G(PSJ("NNAME"))_U_$G(PSJ("NINIT"))_U_$G(PSJ("PHARM"))_U_$G(PSJ("PNAME"))_U_$G(PSJ("PINIT"))
S A=$$SNDTSTA^PSJHL4A(PSJ("PRI"),PSJ("SCHD"))
S ^TMP(PSJTMP,$J,7)=$S(A=1:0,1:1)_U_PSJ("FLG")_U_PSJ("SRC")_U_PSJ("COM")
Q
;
NAME(X,NAME,INIT,IEN) ;Lookup in ^VA(200.
;X = IEN or Name in ^VA(200
;IEN = Return IEN in ^VA(200
;NAME = Return the name in 200
;INIT = Return the initial
NEW DIC,Y
S DIC="^VA(200,",DIC(0)="NZ" D ^DIC
S IEN=+Y
S NAME=$G(Y(0,0))
S INIT=$P($G(Y(0)),U,2)
Q
;
DATE(Y) ; FM internal date/time to user readable, 4 digit year
; Y - date in FileMan internal format
I $G(Y) S Y=Y_$E(".",Y'[".")_"0000" Q $E(Y,4,5)_"/"_$E(Y,6,7)_"/"_($E(Y,1,3)+1700)_" "_$E(Y,9,10)_":"_$E(Y,11,12)
Q "********"
;
STATUS(ON,X) ;
; ON = IEN_"I/U/P"
; X = STATUS
I X="P" Q $S(ON["P":"PENDING",ON["V":"PURGE",1:"NOT FOUND")
Q $S(X="A":"ACTIVE",X="D":"DISCONTINUED",X="E":"EXPIRED",X="H":"HOLD",X="R":"RENEWED",X="RE":"REINSTATED",X="N":"NON-VERFIED",X="DE":"DISCONTINUED (EDIT)",X="O":"ON CALL",1:"NOT FOUND")
;
ADMIN(X) ;
NEW Y,PSJADM,PSJX S PSJADM=""
I X="" Q ""
F Y=1:1:$L(X,"-") S PSJX=$E($P(X,"-",Y)_"0000",1,4) D
. S PSJADM=PSJADM_$S(PSJADM]"":"-",1:"")_PSJX
Q PSJADM
;
PSJBCMA1 ;BIR/MV-RETURN INFORMATION FOR AN ORDER ;16 Mar 99 / 10:59 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**32,41,46,57,63,66,56,58,81,91,104,186,159,173**;16 DEC 97;Build 4
+2 ;
+3 ; Reference to ^PS(50.7 is supported by DBIA 2180.
+4 ; Reference to ^PS(51.2 is supported by DBIA 2178.
+5 ; Reference to ^PS(52.6 is supported by DBIA 1231.
+6 ; Reference to ^PS(52.7 is supported by DBIA 2173.
+7 ; Reference to ^PS(55 is supported by DBIA 2191.
+8 ; Reference to ^PSDRUG is supported by DBIA 2192.
+9 ; Reference to ^DIC is supported by DBIA 10006.
+10 ; Reference to ^DIQ is supported by DBIA 2056.
+11 ; Usage of this routine by BCMA is supported by DBIA 2829.
+12 ;
EN(DFN,ON,PSJTMP) ; return detail data for Inpatient Meds.
+1 NEW F,A
+2 SET PSJTMP=$SELECT($GET(PSJTMP)=1:"PSJ1",1:"PSJ")
+3 IF $GET(ON)["U"
SET F="^PS(55,+$G(DFN),5,+ON"
IF $DATA(@(F_")"))
DO UDVAR
+4 IF $GET(ON)["V"
SET F="^PS(55,+$G(DFN),""IV"",+ON"
IF $DATA(@(F_")"))
DO IVVAR
+5 IF $GET(ON)["P"
SET F="^PS(53.1,+ON"
SET X=$PIECE($GET(^PS(53.1,+ON,0)),U,4)
IF $DATA(@(F_")"))
DO @$SELECT(X="F":"IVVAR",1:"UDVAR")
+6 IF '$DATA(^TMP(PSJTMP,$JOB,0))
SET ^(0)=-1
+7 QUIT
+8 ;
UDVAR ;* Set ^TMP for Unit dose & Pending orders
+1 NEW CNT,X
+2 DO UDPEND
+3 DO TMP
+4 ;* Setup Dispense drug for ^TMP
+5 SET CNT=0
DO NOW^%DTC
+6 FOR X=0:0
SET X=$ORDER(@(F_",1,"_X_")"))
IF 'X
QUIT
Begin DoDot:1
+7 SET PSJDD=@(F_",1,"_X_",0)")
IF $PIECE(PSJDD,"^",3)]""
IF $PIECE(PSJDD,"^",3)'>%
QUIT
+8 SET CNT=CNT+1
+9 SET ^TMP(PSJTMP,$JOB,700,CNT,0)=+PSJDD_U_$PIECE($GET(^PSDRUG(+PSJDD,0)),U)_U_$SELECT((ON["U")&($PIECE(PSJDD,U,2)=""):1,(ON["U")&($EXTRACT($PIECE(PSJDD,U,2))="."):"0"_$PIECE(PSJDD,U,2),1:$PIECE(PSJDD,U,2))_U_$PIECE(PSJDD,U,3)
End DoDot:1
+10 IF CNT
SET ^TMP(PSJTMP,$JOB,700,0)=CNT
+11 KILL PSJ,PSJDD,PSJDN
+12 QUIT
IVVAR ;* Set variables for IV and pending orders
+1 NEW CNT,DN,ND,X,Y
+2 IF ON["P"
DO UDPEND
SET PSJ("INFRATE")=$PIECE($GET(^PS(53.1,ON,8)),U,5)
+3 IF ON["V"
Begin DoDot:1
+4 SET X=$GET(^PS(55,DFN,"IV",+ON,0))
+5 SET PSJ("STARTDT")=$PIECE(X,U,2)
SET PSJ("STOPDT")=$PIECE(X,U,3)
+6 SET PSJ("PROVIDER")=$PIECE(X,U,6)
+7 SET PSJ("INFRATE")=$PIECE(X,U,8)
SET PSJ("SCHD")=$PIECE(X,U,9)
+8 SET PSJ("ADM")=$PIECE(X,U,11)
SET PSJ("AUTO")=$PIECE(X,U,12)
SET PSJ("STATUS")=$PIECE(X,U,17)
+9 SET PSJ("FREQ")=$PIECE(X,U,15)
SET PSJ("IVTYPE")=$PIECE(X,U,4)
+10 SET PSJ("INSYR")=$PIECE(X,U,5)
SET PSJ("CPRS")=$PIECE(X,U,21)
SET PSJ("CHEMO")=$PIECE(X,U,23)
+11 SET X=$GET(^PS(55,DFN,"IV",+ON,.2))
+12 SET PSJ("OI")=$PIECE(X,U)
SET PSJ("DO")=""
SET PSJ("PRI")=$PIECE(X,U,4)
SET PSJ("FLG")=$PIECE(X,U,7)
SET PSJ("COM")=""
SET PSJ("SRC")=""
+13 IF PSJ("FLG")
Begin DoDot:2
+14 NEW S1,A,B,C
+15 SET S1=""
FOR
SET S1=$ORDER(^PS(55,DFN,"IV",+ON,"A",S1),-1)
IF 'S1
QUIT
SET C=$GET(^(S1,0))
SET A=$PIECE(C,U,2)
SET B=$PIECE(C,U,4)
IF A="UG"
QUIT
Begin DoDot:3
+16 IF A'="G"
QUIT
+17 SET PSJ("SRC")=$SELECT(B["FLAGGED BY PHARM":"PHARMACIST",B["FLAGGED BY CPRS":"CPRS",1:"")
+18 SET PSJ("COM")=$PIECE(B," ",4,99)
End DoDot:3
IF PSJ("SRC")]""
QUIT
End DoDot:2
+19 SET PSJ("MR")=$PIECE(X,U,3)
+20 SET X=$GET(^PS(55,DFN,"IV",+ON,4))
+21 SET PSJ("NURSE")=$PIECE(X,U)
+22 SET PSJ("PHARM")=$PIECE(X,U,4)
+23 SET X=$GET(^PS(55,DFN,"IV",+ON,2))
+24 SET PSJ("LDT")=$PIECE(X,U)
+25 SET PSJ("PREV")=$PIECE(X,U,5)
SET PSJ("FOLLOW")=$PIECE(X,U,6)
+26 SET PSJ("SIOPI")=$SELECT($PIECE($GET(^PS(55,DFN,"IV",+ON,3)),"^",2)&($PIECE($GET(^PS(55,DFN,"IV",+ON,3)),"^")'=""):"!",1:"")_$PIECE($GET(^(3)),"^")
+27 ; SCHD var required to shorten $Select
NEW SCHD
SET SCHD=PSJ("SCHD")
+28 SET PSJ("STC")=$$ONE^PSJBCMA(DFN,ON,SCHD,PSJ("STARTDT"),PSJ("STOPDT"))
+29 IF PSJ("STC")=""!(PSJ("STC")="C")
SET PSJ("STC")=$SELECT(SCHD["PRN":"P",1:"C")
+30 IF PSJ("STC")="C"
SET PSJ("STC")=$SELECT(SCHD["ON CALL":"OC",SCHD["ON-CALL":"OC",SCHD["ONCALL":"OC",1:"C")
+31 SET PSJ("NURSE")=$PIECE($GET(^PS(55,DFN,"IV",+ON,4)),U)
End DoDot:1
+32 DO TMP
+33 SET X=$PIECE($GET(^PS(55,DFN,"IV",+ON,1)),U)
IF X]""
SET ^TMP(PSJTMP,$JOB,6)=X
+34 SET CNT=0
+35 FOR X=0:0
SET X=$ORDER(@(F_",""AD"","_X_")"))
IF 'X
QUIT
Begin DoDot:1
+36 ;,AOINAME=$$OIDF^PSJLMUT1(+$P(DN,U,11)) I AOINAME["NOTFOUND" S AOINAME=""
SET ND=$GET(@(F_",""AD"","_X_",0)"))
SET DN=$GET(^PS(52.6,+ND,0))
+37 ;S AOIDF=$$GET1^DIQ(50.7,+$P(DN,U,11),.02) I AOINAME="" S AOIDF=""
+38 ;_U_U_$P(DN,U,11)_U_AOINAME_U_AOIDF
SET CNT=CNT+1
SET ^TMP(PSJTMP,$JOB,850,CNT,0)=+ND_U_$PIECE(DN,U)_U_$PIECE(ND,U,2)_U_$PIECE(ND,U,3)
End DoDot:1
+39 IF CNT
SET ^TMP(PSJTMP,$JOB,850,0)=CNT
SET CNT=0
+40 FOR X=0:0
SET X=$ORDER(@(F_",""SOL"","_X_")"))
IF 'X
QUIT
Begin DoDot:1
+41 ;,SOINAME=$$OIDF^PSJLMUT1(+$P(DN,U,11)) I SOINAME["NOTFOUND" S SOINAME=""
SET ND=$GET(@(F_",""SOL"","_X_",0)"))
SET DN=$GET(^PS(52.7,+ND,0))
+42 ;S SOIDF=$$GET1^DIQ(50.7,+$P(DN,U,11),.02) I SOINAME="" S SOIDF=""
+43 ;_U_U_$P(DN,U,11)_U_SOINAME_U_SOIDF
SET CNT=CNT+1
SET ^TMP(PSJTMP,$JOB,950,CNT,0)=+ND_U_$PIECE(DN,U)_U_$PIECE(ND,U,2)_U_$PIECE(DN,U,4)
End DoDot:1
+44 IF CNT
SET ^TMP(PSJTMP,$JOB,950,0)=CNT
+45 KILL PSJ
+46 SET X1=0
+47 FOR
SET X1=$ORDER(^PS(55,DFN,"IVBCMA",X1))
IF 'X1
QUIT
Begin DoDot:1
+48 SET XX=$GET(^PS(55,DFN,"IVBCMA",X1,0))
IF $PIECE(XX,"^",2)'=+ON
QUIT
SET PSJBCID=$PIECE(XX,"^")
SET X2=0
+49 FOR I=1:1
SET X2=$ORDER(^PS(55,DFN,"IVBCMA",X1,"AD",X2))
IF 'X2
QUIT
SET X=^(X2,0)
SET ^TMP(PSJTMP,$JOB,800,PSJBCID,I)=+X_"^"_$SELECT($DATA(^PS(52.6,+X,0)):$PIECE(^(0),"^"),1:"*****")_"^"_$PIECE(X,"^",2,99)
+50 IF I>1
SET ^TMP(PSJTMP,$JOB,800,PSJBCID,0)=I-1
+51 SET X2=0
+52 FOR I=1:1
SET X2=$ORDER(^PS(55,DFN,"IVBCMA",X1,"SOL",X2))
IF 'X2
QUIT
SET X=^(X2,0)
SET ^TMP(PSJTMP,$JOB,900,PSJBCID,I)=$PIECE(X,"^")_"^"_$SELECT($DATA(^PS(52.7,$PIECE(X,"^"),0)):$PIECE(^(0),"^"),1:"*****")_"^"_$PIECE(X,"^",2,99)
+53 IF I>1
SET ^TMP(PSJTMP,$JOB,900,PSJBCID,0)=I-1
+54 SET ^TMP(PSJTMP,$JOB,1000,PSJBCID)=$PIECE(XX,"^",6)_"^"_$PIECE(XX,"^",8)_"^"_$PIECE(XX,"^",7)
End DoDot:1
+55 QUIT
UDPEND ;
+1 SET X=$GET(@(F_",0)"))
+2 SET PSJ("PROVIDER")=$PIECE(X,U,2)
+3 SET PSJ("MR")=$PIECE(X,U,3)
SET PSJ("SM")=$PIECE(X,U,5)
SET PSJ("HSM")=$PIECE(X,U,6)
+4 SET PSJ("ST")=$PIECE(X,U,7)
SET PSJ("STATUS")=$PIECE(X,U,9)
+5 SET PSJ("LDT")=$PIECE(X,U,16)
+6 IF ON["U"
SET PSJ("NGIVEN")=$PIECE(X,U,22)
+7 SET PSJ("SMYN")=$SELECT(+PSJ("SM"):"YES",1:"NO")
+8 SET PSJ("HSMYN")=$SELECT(+PSJ("HSM"):"YES",1:"NO")
+9 SET PSJ("CPRS")=$PIECE(X,U,21)
SET PSJ("PREV")=$PIECE(X,U,25)
SET PSJ("FOLLOW")=$PIECE(X,U,26)
+10 SET X=$GET(@(F_",.2)"))
+11 SET PSJ("OI")=$PIECE(X,U)
SET PSJ("DO")=$PIECE(X,U,2)
SET PSJ("PRI")=$PIECE(X,U,4)
SET PSJ("FLG")=$PIECE(X,U,7)
SET PSJ("COM")=""
SET PSJ("SRC")=""
+12 IF PSJ("FLG")
Begin DoDot:1
+13 NEW S1,A,B,C
+14 SET S1=""
FOR
SET S1=$ORDER(^PS(55,DFN,5,+ON,9,S1),-1)
IF 'S1
QUIT
SET C=$GET(^(S1,0))
SET A=$PIECE(C,U,3)
SET B=$PIECE(C,U,4)
IF A=7010!(A=7030)
QUIT
Begin DoDot:2
+15 IF A'=7000&(A'=7020)
QUIT
+16 SET PSJ("SRC")=$SELECT(A=7000:"PHARMACIST",A=7020:"CPRS",1:"")
+17 SET PSJ("COM")=$GET(@(F_",13)"))
End DoDot:2
IF PSJ("SRC")]""
QUIT
End DoDot:1
+18 SET X=$GET(@(F_",2)"))
+19 SET PSJ("SCHD")=$PIECE(X,U)
SET PSJ("STARTDT")=$PIECE(X,U,2)
+20 SET PSJ("STC")=PSJ("ST")
+21 IF PSJ("ST")="R"!(PSJ("ST")="C")
SET PSJ("STC")=$SELECT(PSJ("SCHD")["PRN":"P","^ONCALL^ON-CALL^ON CALL^"[("^"_PSJ("SCHD")_"^"):"OC",$$ONE^PSJBCMA(DFN,ON,PSJ("SCHD"))="O":"O",1:"C")
+22 IF PSJ("STC")="O"
SET PSJ("ST")="O"
+23 SET PSJ("STOPDT")=$PIECE(X,U,4)
SET PSJ("ADM")=$PIECE(X,U,5)
+24 SET PSJ("FREQ")=$PIECE(X,U,6)
+25 SET X=$GET(@(F_",4)"))
+26 SET PSJ("NURSE")=$PIECE(X,U)
SET PSJ("AUTO")=$PIECE(X,U,11)
+27 IF ON["U"
SET PSJ("PHARM")=+$PIECE(X,U,3)
+28 ; the naked reference on the line below refers to the full reference created by indirect reference to F, where F may refer to ^PS(53.1 or the IV or UD multiple ^PS(55
+29 SET PSJ("SIOPI")=$SELECT($PIECE($GET(@(F_",6)")),"^",2)&($PIECE($GET(@(F_",6)")),"^")'=""):"!",1:"")_$$ENSET^PSJBCMA($PIECE($GET(^(6)),"^"))
+30 NEW FON
SET FON=ON
DO SIOPI^PSJBCMA
+31 QUIT
+32 ;
TMP ;* Setup ^TMP that have common fields between IV and U/D
+1 DO NAME(PSJ("PROVIDER"),.PSJNAME,"","")
+2 SET PSJ("PRONAME")=PSJNAME
KILL PSJNAME
+3 IF $DATA(PSJ("PHARM"))
Begin DoDot:1
+4 DO NAME(PSJ("PHARM"),.PSJNAME,.PSJINIT,.PSJPIEN)
+5 SET PSJ("PHARM")=PSJPIEN
SET PSJ("PNAME")=PSJNAME
SET PSJ("PINIT")=PSJINIT
KILL PSJNAME,PSJINIT,PSJPIEN
End DoDot:1
+6 IF +PSJ("NURSE")
Begin DoDot:1
+7 DO NAME(PSJ("NURSE"),.PSJNAME,.PSJINIT,"")
+8 SET PSJ("NNAME")=PSJNAME
SET PSJ("NINIT")=PSJINIT
KILL PSJNAME,PSJINIT
End DoDot:1
+9 SET A=$GET(^PS(51.2,+PSJ("MR"),0))
SET PSJ("MRNM")=$PIECE(A,U)
SET PSJ("MRABB")=$PIECE(A,U,3)
SET PSJ("MRPIJ")=$PIECE(A,U,8)
SET PSJ("MRIVP")=$PIECE(A,U,9)
+10 SET PSJ("OINAME")=$$OIDF^PSJLMUT1(+PSJ("OI"))
IF PSJ("OINAME")["NOT FOUND"
SET PSJ("OINAME")=""
+11 SET PSJ("OIDF")=$$GET1^DIQ(50.7,+PSJ("OI"),.02)
+12 IF PSJ("OINAME")=""
SET PSJ("OIDF")=""
+13 SET PSJ("LDTN")=$$DATE(PSJ("LDT"))
+14 SET PSJ("STARTDTN")=$$DATE(PSJ("STARTDT"))
+15 SET PSJ("STOPDTN")=$$DATE(PSJ("STOPDT"))
+16 SET X=$SELECT(ON["V":PSJ("STC"),1:PSJ("ST"))
+17 SET PSJ("STNAME")=$SELECT(X="C":"CONTINUOUS",X="O":"ONE TIME",X="P":"PRN",X="R":"FILL ON REQUEST",X="OC":"ON CALL",1:"NOT FOUND")
+18 ;
+19 SET ^TMP(PSJTMP,$JOB,0)=DFN_U_+ON_U_ON_U_PSJ("PREV")_U_PSJ("FOLLOW")_U_$GET(PSJ("IVTYPE"))_U_$GET(PSJ("INSYR"))_U_$GET(PSJ("CHEMO"))_U_PSJ("CPRS")
+20 SET ^TMP(PSJTMP,$JOB,1)=PSJ("PROVIDER")_U_PSJ("PRONAME")_U_PSJ("MR")_U_PSJ("MRABB")_U_$GET(PSJ("SM"))_U_$GET(PSJ("SMYN"))_U_$GET(PSJ("HSM"))_U_$GET(PSJ("HSMYN"))_U_$GET(PSJ("NGIVEN"))_U_PSJ("STATUS")
+21 SET ^TMP(PSJTMP,$JOB,1)=^TMP(PSJTMP,$JOB,1)_U_$$STATUS(ON,PSJ("STATUS"))_U_$GET(PSJ("AUTO"))_U_$GET(PSJ("MRNM"))
+22 SET ^TMP(PSJTMP,$JOB,1,0)=PSJ("MRPIJ")_U_$GET(PSJ("MRIVP"))
+23 SET ^TMP(PSJTMP,$JOB,2)=PSJ("OI")_U_PSJ("OINAME")_U_PSJ("DO")_U_$GET(PSJ("INFRATE"))_U_$GET(PSJ("SCHD"))_U_PSJ("OIDF")
+24 SET ^TMP(PSJTMP,$JOB,3)=PSJ("SIOPI")
+25 SET ^TMP(PSJTMP,$JOB,4)=PSJ("STC")_U_$GET(PSJ("STNAME"))_U_PSJ("LDT")_U_PSJ("LDTN")_U_PSJ("STARTDT")_U_PSJ("STARTDTN")_U_PSJ("STOPDT")_U_PSJ("STOPDTN")_U_$$ADMIN(PSJ("ADM"))_U_$GET(PSJ("ST"))_U_$GET(PSJ("FREQ"))
+26 SET ^TMP(PSJTMP,$JOB,5)=$GET(PSJ("NURSE"))_U_$GET(PSJ("NNAME"))_U_$GET(PSJ("NINIT"))_U_$GET(PSJ("PHARM"))_U_$GET(PSJ("PNAME"))_U_$GET(PSJ("PINIT"))
+27 SET A=$$SNDTSTA^PSJHL4A(PSJ("PRI"),PSJ("SCHD"))
+28 SET ^TMP(PSJTMP,$JOB,7)=$SELECT(A=1:0,1:1)_U_PSJ("FLG")_U_PSJ("SRC")_U_PSJ("COM")
+29 QUIT
+30 ;
NAME(X,NAME,INIT,IEN) ;Lookup in ^VA(200.
+1 ;X = IEN or Name in ^VA(200
+2 ;IEN = Return IEN in ^VA(200
+3 ;NAME = Return the name in 200
+4 ;INIT = Return the initial
+5 NEW DIC,Y
+6 SET DIC="^VA(200,"
SET DIC(0)="NZ"
DO ^DIC
+7 SET IEN=+Y
+8 SET NAME=$GET(Y(0,0))
+9 SET INIT=$PIECE($GET(Y(0)),U,2)
+10 QUIT
+11 ;
DATE(Y) ; FM internal date/time to user readable, 4 digit year
+1 ; Y - date in FileMan internal format
+2 IF $GET(Y)
SET Y=Y_$EXTRACT(".",Y'[".")_"0000"
QUIT $EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_($EXTRACT(Y,1,3)+1700)_" "_$EXTRACT(Y,9,10)_":"_$EXTRACT(Y,11,12)
+3 QUIT "********"
+4 ;
STATUS(ON,X) ;
+1 ; ON = IEN_"I/U/P"
+2 ; X = STATUS
+3 IF X="P"
QUIT $SELECT(ON["P":"PENDING",ON["V":"PURGE",1:"NOT FOUND")
+4 QUIT $SELECT(X="A":"ACTIVE",X="D":"DISCONTINUED",X="E":"EXPIRED",X="H":"HOLD",X="R":"RENEWED",X="RE":"REINSTATED",X="N":"NON-VERFIED",X="DE":"DISCONTINUED (EDIT)",X="O":"ON CALL",1:"NOT FOUND")
+5 ;
ADMIN(X) ;
+1 NEW Y,PSJADM,PSJX
SET PSJADM=""
+2 IF X=""
QUIT ""
+3 FOR Y=1:1:$LENGTH(X,"-")
SET PSJX=$EXTRACT($PIECE(X,"-",Y)_"0000",1,4)
Begin DoDot:1
+4 SET PSJADM=PSJADM_$SELECT(PSJADM]"":"-",1:"")_PSJX
End DoDot:1
+5 QUIT PSJADM
+6 ;
