PSJOEEW ;BIR/CML3-SHOW INPATIENT FIELDS FOR EDIT ;17 SEP 97 / 1:41 PM
;;5.0; INPATIENT MEDICATIONS ;**81**;16 DEC 97
;
; Reference to ^PS(50.7 is supported by DBIA 2180.
; Reference to ^PS(51.2 is supported by DBIA 2178.
; 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.
;
EN1 ;
S PSGORD=^TMP("PSJON",$J,PSGOE2)
;
EN2 ;
N %X,%Y,AT,DO,DRGI,FL,FQC,NF,OD,PRI,SIG,ST,STD,STT,X,Y K ^PS(53.45,PSJSYSP,1),^(2),^(4) I PSGORD["V" D EN3,SET Q
S NF=$S(PSGORD["A":0,1:1) I NF,$D(^PS(53.1,+PSGORD,0)),$P(^(0),"^",19),$D(^PS(55,PSGP,5,$P(^(0),"^",19))) S PSGORD=$P(^PS(53.1,+PSGORD,0),"^",19)_"A",NF=0
S Y="",PSGOEEWF="^PS("_$S(NF:"53.1,",1:"55,"_PSGP_",5,")_+PSGORD_","
; naked ref below refers to line above
S OD=$G(@(PSGOEEWF_"0)")),AT=$G(^(2)),PSGEB=$P($G(^(4)),"^",7),PSGOSI=$P($G(^(6)),"^"),SIG=$G(^(6.5)),DO=$G(^(.2)),PSGOPD=$P(DO,"^"),PSGODO=$P(DO,"^",2)
S PSGOPR=$$PRCHK^PSJORUT2(DUZ) S:'PSGOPR PSGOPR=$P(OD,U,2)
S PSGOMR=$P(OD,"^",3),PSGOSM=$P(OD,"^",5),PSGOHSM=$P(OD,"^",6),(PSGOST,ST)=$P(OD,"^",7),(PSGSTAT,STT)=$P(OD,"^",9),PSGLID=$P(OD,"^",16)
S PSGNEDFD=$P($$GTNEDFD^PSGOE7("UI",PSGOPD),U)
S PSGOSCH=$P(AT,"^"),PSGOSD=$P(AT,"^",2),PSGOFD=$P(AT,"^",4),(FQC,PSGS0XT)=$P(AT,"^",6),PSGOAT=$P(AT,"^",5)
I FQC="D",PSGOAT="" S PSGOAT=$E($P(STD,".",2)_"0000",1,4)
S PRI=$S('PSGOPR:0,1:$P($G(^VA(200,PSGOPR,"PS")),"^",4)),DRGI=$S(PSGOPD'=+PSGOPD:0,1:+$G(^PSDRUG(+PSGOPD,"I"))) S:PRI PRI=DT'<PRI S:DRGI DRGI=DT'<DRGI
S PSGSTAT=$S(STT="":"NOT FOUND",STT["D":"DISCONTINUED"_$S(STT["R":" (RENEWAL)",1:" (EDIT)"),STT="R":$S(NF:"RELEASED",1:"RENEWED"),STT="RE":"REINSTATED",1:STT)
I STT=PSGSTAT S PSGSTAT=$P(STT_"^ACTIVE^EXPIRED^HOLD^INCOMPLETE^NON-VERIFIED^PENDING^UNRELEASED","^",$F("AEHINPU",STT))
S %X=PSGOEEWF_"3,",%Y="^PS(53.45,"_PSJSYSP_",1," D %XY^%RCR S %X=PSGOEEWF_"1,",%Y="^PS(53.45,"_PSJSYSP_",2," D %XY^%RCR S %X=PSGOEEWF_"12,",%Y="^PS(53.45,"_PSJSYSP_",4," D %XY^%RCR
S $P(^PS(53.45,PSJSYSP,2,0),"^",2)="53.4502P"
;
SET ;
I $S($D(PSGOEF):0,1:PSGORD["U") S (PSGOFD,PSGOSD,PSGOST,ST)=""
S PSGOSTN=$$ENSTN^PSGMI(ST),(PSGOFDN,PSGOSDN)="" I PSGOSD S PSGOSDN=$$ENDD^PSGMI(PSGOSD)_"^"_$$ENDTC^PSGMI(PSGOSD)
I PSGOFD S PSGOFDN=$$ENDD^PSGMI(PSGOFD)_"^"_$$ENDTC^PSGMI(PSGOFD)
S PSGOPDN=$S('PSGOPD:"",1:$P($G(^PS(50.7,PSGOPD,0)),"^")) S:PSGOPDN="" PSGOPDN=PSGOPD S PSGOPRN=$S('PSGOPR:"",1:$P($G(^VA(200,PSGOPR,0)),"^")) S:PSGOPRN="" PSGOPRN=PSGOPR
S PSGLID=$$ENDTC^PSGMI(PSGLID),PSGEBN=$$ENNPN^PSGMI(PSGEB),PSGOMRN=$S('PSGOMR:"",1:$P($G(^PS(51.2,PSGOMR,0)),"^")) S:PSGOMRN="" PSGOMRN=PSGOMR
F X="PD","PDN","MR","MRN","ST","STN","SCH","SI","SD","SDN","FD","FDN","SM","HSM","PR","PRN","DO","AT" S @("PSG"_X)=$G(@("PSGO"_X))
Q
;
EN3 ;
S PSGOEEWF="^PS(55,"_PSGP_",""IV"",",ND=$G(^PS(55,PSGP,"IV",+PSGORD,0)),ND2=$G(^(2)),ND6=$G(^(.2))
S PSGOSD=$P(ND,"^",2),PSGOFD=$P(ND,"^",3),PSGOPR=$$PRCHK^PSJORUT2(DUZ)
S:'PSGOPR PSGOPR=$P(ND,"^",6) S PSGOSCH=$P(ND,"^",9),(PSGOAT,PSGS0Y)=$P(ND,"^",11),PSGS0XT=$P(ND,"^",15),PSGSTAT=$$CODES^PSIVUTL($P(ND,U,17),55.01,100)
S PSGLID=$P(ND2,"^"),PSGEB=$P(ND2,"^",3)
S PSGOPD=$P(ND6,"^"),PSGODO=$P(ND6,"^",2),PSGOMR=$P(ND6,"^",3)
S (PSGOST,PSGST,ST)=$S(PSGOSD=PSGOFD:"O",1:"C"),(PSGSM,PSGHSM,PSGNEDFD)="" S:PSGST="O" PSGS0XT="O"
K ^PS(53.45,PSJSYSP,4) S %X=PSGOEEWF_+PSGORD_",5,",%Y="^PS(53.45,"_PSJSYSP_",4," D %XY^%RCR
Q
;
ENW ;
N D,ND,Q,QQ
W:$Y @IOF,! W " Patient: ",$P(PSGP(0),"^")," (",PSJPPID,")",?55,"Ht(cm): " W:PSJPHT["_" PSJPHT W:PSJPHT'["_" $J(PSJPHT,6,2)
W " ",PSJPHTD,!?4,"Ward: ",PSJPWDN,?55,"Wt(kg): " W:PSJPWT["_" PSJPWT W:PSJPWT'["_" $J(PSJPWT,6,2) W " ",PSJPWTD,!,"Room-Bed: ",PSJPRB
W !?5,"Entered: ",PSGLID," By: ",PSGEBN,!,"Order Status: ",PSGSTAT,!,"--------------------------------------------------------------------------------"
S Q=$G(PSJORUR) W !?1,$S(Q:" ",$D(PSGEFN(1)):$E(" *",PSGEFN(1)+1)_"(1)",1:" "),?19,"Drug: ",PSGPDN
W !?1,$S(Q:" ",$D(PSGEFN(2)):$E(" *",PSGEFN(2)+1)_"(2)",1:" "),?9,"Dosage Ordered: ",PSGDO
W !?1,$S(Q:" ",$D(PSGEFN(3)):$E(" *",PSGEFN(3)+1)_"(3)",1:" "),?14,"Med Route: ",PSGMRN
W !?1,$S(Q:" ",$D(PSGEFN(4)):$E(" *",PSGEFN(4)+1)_"(4)",1:" "),?15,"Schedule: ",PSGSCH
W !?1,$S(Q:"(1)",$D(PSGEFN(5)):$E(" *",PSGEFN(5)+1)_"(5)",1:" "),?15,"Provider: ",PSGPRN
W !!?1,$S(Q:"(2)",$D(PSGEFN(6)):$E(" *",PSGEFN(6)+1)_"(6)",1:" ")," Provider Comments:" F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,4,Q)) Q:'Q N Y,Y2 S Y=" "_$G(^(Q,0)) F KKA=2:1 S Y2=$P(Y," ",KKA) Q:Y2="" W:$L(Y2)+$X>79 !?7 W " ",Y2
K KKA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJOEEW 4608 printed Apr 09, 2024@21:08:09 Page 2
PSJOEEW ;BIR/CML3-SHOW INPATIENT FIELDS FOR EDIT ;17 SEP 97 / 1:41 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**81**;16 DEC 97
+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(55 is supported by DBIA 2191.
+6 ; Reference to ^PSDRUG( is supported by DBIA 2192.
+7 ; Reference to ^VA(200 is supported by DBIA 10060.
+8 ;
EN1 ;
+1 SET PSGORD=^TMP("PSJON",$JOB,PSGOE2)
+2 ;
EN2 ;
+1 NEW %X,%Y,AT,DO,DRGI,FL,FQC,NF,OD,PRI,SIG,ST,STD,STT,X,Y
KILL ^PS(53.45,PSJSYSP,1),^(2),^(4)
IF PSGORD["V"
DO EN3
DO SET
QUIT
+2 SET NF=$SELECT(PSGORD["A":0,1:1)
IF NF
IF $DATA(^PS(53.1,+PSGORD,0))
IF $PIECE(^(0),"^",19)
IF $DATA(^PS(55,PSGP,5,$PIECE(^(0),"^",19)))
SET PSGORD=$PIECE(^PS(53.1,+PSGORD,0),"^",19)_"A"
SET NF=0
+3 SET Y=""
SET PSGOEEWF="^PS("_$SELECT(NF:"53.1,",1:"55,"_PSGP_",5,")_+PSGORD_","
+4 ; naked ref below refers to line above
+5 SET OD=$GET(@(PSGOEEWF_"0)"))
SET AT=$GET(^(2))
SET PSGEB=$PIECE($GET(^(4)),"^",7)
SET PSGOSI=$PIECE($GET(^(6)),"^")
SET SIG=$GET(^(6.5))
SET DO=$GET(^(.2))
SET PSGOPD=$PIECE(DO,"^")
SET PSGODO=$PIECE(DO,"^",2)
+6 SET PSGOPR=$$PRCHK^PSJORUT2(DUZ)
if 'PSGOPR
SET PSGOPR=$PIECE(OD,U,2)
+7 SET PSGOMR=$PIECE(OD,"^",3)
SET PSGOSM=$PIECE(OD,"^",5)
SET PSGOHSM=$PIECE(OD,"^",6)
SET (PSGOST,ST)=$PIECE(OD,"^",7)
SET (PSGSTAT,STT)=$PIECE(OD,"^",9)
SET PSGLID=$PIECE(OD,"^",16)
+8 SET PSGNEDFD=$PIECE($$GTNEDFD^PSGOE7("UI",PSGOPD),U)
+9 SET PSGOSCH=$PIECE(AT,"^")
SET PSGOSD=$PIECE(AT,"^",2)
SET PSGOFD=$PIECE(AT,"^",4)
SET (FQC,PSGS0XT)=$PIECE(AT,"^",6)
SET PSGOAT=$PIECE(AT,"^",5)
+10 IF FQC="D"
IF PSGOAT=""
SET PSGOAT=$EXTRACT($PIECE(STD,".",2)_"0000",1,4)
+11 SET PRI=$SELECT('PSGOPR:0,1:$PIECE($GET(^VA(200,PSGOPR,"PS")),"^",4))
SET DRGI=$SELECT(PSGOPD'=+PSGOPD:0,1:+$GET(^PSDRUG(+PSGOPD,"I")))
if PRI
SET PRI=DT'<PRI
if DRGI
SET DRGI=DT'<DRGI
+12 SET PSGSTAT=$SELECT(STT="":"NOT FOUND",STT["D":"DISCONTINUED"_$SELECT(STT["R":" (RENEWAL)",1:" (EDIT)"),STT="R":$SELECT(NF:"RELEASED",1:"RENEWED"),STT="RE":"REINSTATED",1:STT)
+13 IF STT=PSGSTAT
SET PSGSTAT=$PIECE(STT_"^ACTIVE^EXPIRED^HOLD^INCOMPLETE^NON-VERIFIED^PENDING^UNRELEASED","^",$FIND("AEHINPU",STT))
+14 SET %X=PSGOEEWF_"3,"
SET %Y="^PS(53.45,"_PSJSYSP_",1,"
DO %XY^%RCR
SET %X=PSGOEEWF_"1,"
SET %Y="^PS(53.45,"_PSJSYSP_",2,"
DO %XY^%RCR
SET %X=PSGOEEWF_"12,"
SET %Y="^PS(53.45,"_PSJSYSP_",4,"
DO %XY^%RCR
+15 SET $PIECE(^PS(53.45,PSJSYSP,2,0),"^",2)="53.4502P"
+16 ;
SET ;
+1 IF $SELECT($DATA(PSGOEF):0,1:PSGORD["U")
SET (PSGOFD,PSGOSD,PSGOST,ST)=""
+2 SET PSGOSTN=$$ENSTN^PSGMI(ST)
SET (PSGOFDN,PSGOSDN)=""
IF PSGOSD
SET PSGOSDN=$$ENDD^PSGMI(PSGOSD)_"^"_$$ENDTC^PSGMI(PSGOSD)
+3 IF PSGOFD
SET PSGOFDN=$$ENDD^PSGMI(PSGOFD)_"^"_$$ENDTC^PSGMI(PSGOFD)
+4 SET PSGOPDN=$SELECT('PSGOPD:"",1:$PIECE($GET(^PS(50.7,PSGOPD,0)),"^"))
if PSGOPDN=""
SET PSGOPDN=PSGOPD
SET PSGOPRN=$SELECT('PSGOPR:"",1:$PIECE($GET(^VA(200,PSGOPR,0)),"^"))
if PSGOPRN=""
SET PSGOPRN=PSGOPR
+5 SET PSGLID=$$ENDTC^PSGMI(PSGLID)
SET PSGEBN=$$ENNPN^PSGMI(PSGEB)
SET PSGOMRN=$SELECT('PSGOMR:"",1:$PIECE($GET(^PS(51.2,PSGOMR,0)),"^"))
if PSGOMRN=""
SET PSGOMRN=PSGOMR
+6 FOR X="PD","PDN","MR","MRN","ST","STN","SCH","SI","SD","SDN","FD","FDN","SM","HSM","PR","PRN","DO","AT"
SET @("PSG"_X)=$GET(@("PSGO"_X))
+7 QUIT
+8 ;
EN3 ;
+1 SET PSGOEEWF="^PS(55,"_PSGP_",""IV"","
SET ND=$GET(^PS(55,PSGP,"IV",+PSGORD,0))
SET ND2=$GET(^(2))
SET ND6=$GET(^(.2))
+2 SET PSGOSD=$PIECE(ND,"^",2)
SET PSGOFD=$PIECE(ND,"^",3)
SET PSGOPR=$$PRCHK^PSJORUT2(DUZ)
+3 if 'PSGOPR
SET PSGOPR=$PIECE(ND,"^",6)
SET PSGOSCH=$PIECE(ND,"^",9)
SET (PSGOAT,PSGS0Y)=$PIECE(ND,"^",11)
SET PSGS0XT=$PIECE(ND,"^",15)
SET PSGSTAT=$$CODES^PSIVUTL($PIECE(ND,U,17),55.01,100)
+4 SET PSGLID=$PIECE(ND2,"^")
SET PSGEB=$PIECE(ND2,"^",3)
+5 SET PSGOPD=$PIECE(ND6,"^")
SET PSGODO=$PIECE(ND6,"^",2)
SET PSGOMR=$PIECE(ND6,"^",3)
+6 SET (PSGOST,PSGST,ST)=$SELECT(PSGOSD=PSGOFD:"O",1:"C")
SET (PSGSM,PSGHSM,PSGNEDFD)=""
if PSGST="O"
SET PSGS0XT="O"
+7 KILL ^PS(53.45,PSJSYSP,4)
SET %X=PSGOEEWF_+PSGORD_",5,"
SET %Y="^PS(53.45,"_PSJSYSP_",4,"
DO %XY^%RCR
+8 QUIT
+9 ;
ENW ;
+1 NEW D,ND,Q,QQ
+2 if $Y
WRITE @IOF,!
WRITE " Patient: ",$PIECE(PSGP(0),"^")," (",PSJPPID,")",?55,"Ht(cm): "
if PSJPHT["_"
WRITE PSJPHT
if PSJPHT'["_"
WRITE $JUSTIFY(PSJPHT,6,2)
+3 WRITE " ",PSJPHTD,!?4,"Ward: ",PSJPWDN,?55,"Wt(kg): "
if PSJPWT["_"
WRITE PSJPWT
if PSJPWT'["_"
WRITE $JUSTIFY(PSJPWT,6,2)
WRITE " ",PSJPWTD,!,"Room-Bed: ",PSJPRB
+4 WRITE !?5,"Entered: ",PSGLID," By: ",PSGEBN,!,"Order Status: ",PSGSTAT,!,"--------------------------------------------------------------------------------"
+5 SET Q=$GET(PSJORUR)
WRITE !?1,$SELECT(Q:" ",$DATA(PSGEFN(1)):$EXTRACT(" *",PSGEFN(1)+1)_"(1)",1:" "),?19,"Drug: ",PSGPDN
+6 WRITE !?1,$SELECT(Q:" ",$DATA(PSGEFN(2)):$EXTRACT(" *",PSGEFN(2)+1)_"(2)",1:" "),?9,"Dosage Ordered: ",PSGDO
+7 WRITE !?1,$SELECT(Q:" ",$DATA(PSGEFN(3)):$EXTRACT(" *",PSGEFN(3)+1)_"(3)",1:" "),?14,"Med Route: ",PSGMRN
+8 WRITE !?1,$SELECT(Q:" ",$DATA(PSGEFN(4)):$EXTRACT(" *",PSGEFN(4)+1)_"(4)",1:" "),?15,"Schedule: ",PSGSCH
+9 WRITE !?1,$SELECT(Q:"(1)",$DATA(PSGEFN(5)):$EXTRACT(" *",PSGEFN(5)+1)_"(5)",1:" "),?15,"Provider: ",PSGPRN
+10 WRITE !!?1,$SELECT(Q:"(2)",$DATA(PSGEFN(6)):$EXTRACT(" *",PSGEFN(6)+1)_"(6)",1:" ")," Provider Comments:"
FOR Q=0:0
SET Q=$ORDER(^PS(53.45,PSJSYSP,4,Q))
if 'Q
QUIT
NEW Y,Y2
SET Y=" "_$GET(^(Q,0))
FOR KKA=2:1
SET Y2=$PIECE(Y," ",KKA)
if Y2=""
QUIT
if $LENGTH(Y2)+$X>79
WRITE !?7
WRITE " ",Y2
+11 KILL KKA
+12 QUIT
