PSGOEEW ;BIR/CML3-SHOW FIELDS FOR EDIT ;15 DEC 97 1:29 PM
;;5.0;INPATIENT MEDICATIONS;**7,58,111,315,373,366**;16 DEC 97;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
; Reference to ^PS(51.2 is supported by DBIA 2178.
; Reference to ^PSDRUG( is supported by DBIA 2192.
;
EN1 ;
S PSGORD=^TMP("PSJON",$J,PSGOE2)
;
EN2 ;
N %X,%Y,AT,RT,DO,DRGI,FD,FL,FQC,NF,PRI,SD,SIG,ST,STD,STT,X,Y ;*315
;naked references below refer to the full reference in the indirection @(PSGOEEWF_"0")
S OD=$G(@(PSGOEEWF_"0)")),AT=$G(^(2)),RT=$G(^(2.1)),PSGEB=$P($G(^(4)),"^",7),PSGOSI=$G(^(6)),DO=$G(^(.2)),PSGOINST=$G(^(.3)),PSGOPD=$P(DO,"^"),PSGODO=$P(DO,"^",2) ;*315
S PSGOPR=$P(OD,"^",2),PSGOMR=$P(OD,"^",3),PSGOSM=$P(OD,"^",5),PSGOHSM=$P(OD,"^",6),(PSGOST,ST)=$P(OD,"^",7),(PSGSTAT,STT)=$P(OD,"^",9),PSGOMRN=$S('PSGOMR:"",1:$P($G(^PS(51.2,PSGOMR,0)),"^")) S:PSGOMRN="" PSGOMRN=PSGOMR
S PSGLI=$P(OD,U,16),PSGNEDFD=$P($$GTNEDFD^PSGOE7("U",PSGOPD),U),PSGOSCH=$P(AT,"^"),(PSGOSD,SD)=$P(AT,"^",2),(FD,PSGOFD)=$P(AT,"^",4),(FQC,PSGS0XT)=$P(AT,"^",6),(PSGOAT,PSGS0Y)=$P(AT,"^",5)
;*366 - check provider credentials
S PRI=$S('PSGOPR:0,1:'$$ACTPRO^PSGOE1(PSGOPR)),DRGI=$S(PSGOPD'=+PSGOPD:0,1:+$G(^PSDRUG(+PSGOPD,"I"))) S:DRGI DRGI=DT'<DRGI
S PDRG=PSGOPD,PSGOPDN=$S('PSGOPD:"",1:$$OINAME^PSJLMUTL(+PSGOPD)) S:PSGOPDN="" PSGOPDN=PSGOPD S PSGOPRN=$S('PSGOPR:"",1:$P($G(^VA(200,PSGOPR,0)),"^")) S:PSGOPRN="" PSGOPRN=PSGOPR
S PSGEBN=$$ENNPN^PSGMI(PSGEB)
S PSGSTAT=$S(STT="":"NOT FOUND",STT="RE":"REINSTATED",1:$P(STT_"^ACTIVE^DISCONTINUED^EXPIRED^HOLD^INCOMPLETE^NON-VERIFIED^PENDING^RENEWED^UNRELEASED","^",$F("ADEHINPRU",STT)))
;
SET ;
S PSGOSTN=$$ENSTN^PSGMI(ST),(PSGOFDN,PSGOSDN)="" I SD S PSGOSDN=$$ENDD^PSGMI(SD)_"^"_$$ENDTC2^PSGMI(SD) ;373
I FD S PSGOFDN=$$ENDD^PSGMI(FD)_"^"_$$ENDTC2^PSGMI(FD) ;373
F X="PD","PDN","MR","MRN","ST","STN","SCH","SI","SD","SDN","FD","FDN","SM","HSM","PR","PRN","DO","AT" S @("PSG"_X)=@("PSGO"_X)
K ^PS(53.45,PSJSYSP,1),^(2) 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 $P(^PS(53.45,PSJSYSP,2,0),"^",2)="53.4502P"
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 !,"Order Status: ",PSGSTAT,?37,"Entered By: ",PSGEBN,!,"--------------------------------------------------------------------------------"
W !?1,$S($D(PSGEFN(1)):$E(" *",PSGEFN(1)+1)_"(1)",1:" "),?16,"Drug: ",PSGPDN
W !?1,$S($D(PSGEFN(2)):$E(" *",PSGEFN(2)+1)_"(2)",1:" "),?6,"Dosage Ordered: ",PSGDO,?46,$S($D(PSGEFN(12)):$E(" *",PSGEFN(12)+1)_"(12)",1:" ")," Start: ",$P(PSGSDN,"^",2)
W !?1,$S($D(PSGEFN(3)):$E(" *",PSGEFN(3)+1)_"(3)",1:" "),?11,"Med Route: ",PSGMRN,?46,$S($D(PSGEFN(13)):$E(" *",PSGEFN(13)+1)_"(13)",1:" ")," Stop: ",$P(PSGFDN,"^",2)
W !?1,$S($D(PSGEFN(4)):$E(" *",PSGEFN(4)+1)_"(4)",1:" "),?7,"Schedule Type: ",PSGSTN,?46,$S($D(PSGEFN(14)):$E(" *",PSGEFN(14)+1)_"(14)",1:" ")," Self Med: ",$P("NO^YES","^",PSGSM+1) I PSGSM,PSGHSM W " (HS)"
W !?1,$S($D(PSGEFN(5)):$E(" *",PSGEFN(5)+1)_"(5)",1:" "),?12,"Schedule: ",PSGSCH
W !?1,$S($D(PSGEFN(6)):$E(" *",PSGEFN(6)+1)_"(6)",1:" "),?9,"Admin Times: ",PSGAT
W !?1,$S($D(PSGEFN(7)):$E(" *",PSGEFN(7)+1)_"(7)",1:" "),?12,"Provider: ",PSGPRN
W !?1,$S($D(PSGEFN(8)):$E(" *",PSGEFN(8)+1)_"(8)",1:" ")," Special Instructions: " I PSGSI]"" F Q=1:1:$L(PSGSI," ") S QQ=$P(PSGSI," ",Q) W:$L(QQ)+$X>79 !?28 W QQ," "
W !!?1,$S($D(PSGEFN(9)):$E(" *",PSGEFN(9)+1)_"(9)",1:" ")," Dispense Drug",?48,"U/D",?60,"Inactive Date",!,"-------------------------------------------------------------------------------"
F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,2,Q)) Q:'Q S ND=$G(^(Q,0)) D
.S D=$P(ND,"^"),PSGID=$P(ND,"^",3) I PSGID S PSGID=$$ENDTC^PSGMI(PSGID)
.S D=$S(D="":"NOT FOUND",'$D(^PSDRUG(D,0)):D,$P(^(0),"^")]"":$P(^(0),"^"),1:D_";PSDRUG(") W !?6,D,?48,$S($P(ND,"^",2):$P(ND,"^",2),1:1) W:PSGID ?60,PSGID
W !!,$S($D(PSGEFN(10)):$E(" *",PSGEFN(10)+1)_"(10)",1:" ")," Comments:" F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,1,Q)) Q:'Q S Y=" "_$G(^(Q,0)) F Y1=2:1 S Y2=$P(Y," ",Y1) Q:Y2="" W:$L(Y2)+$X>79 !?2 W " ",Y2
W !!,$S($D(PSGEFN(11)):$E(" *",PSGEFN(11)+1)_"(11)",1:" ")," Provider Comments:"
I $G(PSGORD) D
.I $D(^PS(53.1,+PSGORD,12,1)) F Q=0:0 S Q=$O(^PS(53.1,+PSGORD,12,Q)) Q:'Q W !?2,$G(^(Q,0)) Q
.I $D(^PS(53.1,+PSGORD,6)) W !?2,$G(^(6))
K Q,Y,Y1,Y2
Q
;
ENKILL ;
K PSGAT,PSGEB,PSGFD,PSGHSM,PSGNEFD,PSGNESD,PSGOEEF,PSGOEER,PSGOFD,PSGOHSM,PSGOMR,PSGOMRN,PSGOPD,PSGOPDN,PSGOPR,PSGOSCH,PSGOSD,PSGOSM,PSGOST,PSGPD,PSGPDN,PSGPR,PSGSD,PSGSM Q
HILIGHT ;
;
5 ;;3,46,34
7 ;;4,7,45
8 ;;8,5,80
10 ;;2,46,34
25 ;;3,46,34
26 ;;6,12,56
39 ;;6,9,71
40 ;;
66 ;;9,5,80
101 ;;1,6,74
109 ;;2,6,40
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGOEEW 5000 printed Dec 13, 2024@02:02:08 Page 2
PSGOEEW ;BIR/CML3-SHOW FIELDS FOR EDIT ;15 DEC 97 1:29 PM
+1 ;;5.0;INPATIENT MEDICATIONS;**7,58,111,315,373,366**;16 DEC 97;Build 7
+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 ^PSDRUG( is supported by DBIA 2192.
+5 ;
EN1 ;
+1 SET PSGORD=^TMP("PSJON",$JOB,PSGOE2)
+2 ;
EN2 ;
+1 ;*315
NEW %X,%Y,AT,RT,DO,DRGI,FD,FL,FQC,NF,PRI,SD,SIG,ST,STD,STT,X,Y
+2 ;naked references below refer to the full reference in the indirection @(PSGOEEWF_"0")
+3 ;*315
SET OD=$GET(@(PSGOEEWF_"0)"))
SET AT=$GET(^(2))
SET RT=$GET(^(2.1))
SET PSGEB=$PIECE($GET(^(4)),"^",7)
SET PSGOSI=$GET(^(6))
SET DO=$GET(^(.2))
SET PSGOINST=$GET(^(.3))
SET PSGOPD=$PIECE(DO,"^")
SET PSGODO=$PIECE(DO,"^",2)
+4 SET PSGOPR=$PIECE(OD,"^",2)
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 PSGOMRN=$SELECT('PSGOMR:"",1:$PIECE($GET(^PS(51.2,PSGOMR,0)),"^"))
if PSGOMRN=""
SET PSGOMRN=PSGOMR
+5 SET PSGLI=$PIECE(OD,U,16)
SET PSGNEDFD=$PIECE($$GTNEDFD^PSGOE7("U",PSGOPD),U)
SET PSGOSCH=$PIECE(AT,"^")
SET (PSGOSD,SD)=$PIECE(AT,"^",2)
SET (FD,PSGOFD)=$PIECE(AT,"^",4)
SET (FQC,PSGS0XT)=$PIECE(AT,"^",6)
SET (PSGOAT,PSGS0Y)=$PIECE(AT,"^",5)
+6 ;*366 - check provider credentials
+7 SET PRI=$SELECT('PSGOPR:0,1:'$$ACTPRO^PSGOE1(PSGOPR))
SET DRGI=$SELECT(PSGOPD'=+PSGOPD:0,1:+$GET(^PSDRUG(+PSGOPD,"I")))
if DRGI
SET DRGI=DT'<DRGI
+8 SET PDRG=PSGOPD
SET PSGOPDN=$SELECT('PSGOPD:"",1:$$OINAME^PSJLMUTL(+PSGOPD))
if PSGOPDN=""
SET PSGOPDN=PSGOPD
SET PSGOPRN=$SELECT('PSGOPR:"",1:$PIECE($GET(^VA(200,PSGOPR,0)),"^"))
if PSGOPRN=""
SET PSGOPRN=PSGOPR
+9 SET PSGEBN=$$ENNPN^PSGMI(PSGEB)
+10 SET PSGSTAT=$SELECT(STT="":"NOT FOUND",STT="RE":"REINSTATED",1:$PIECE(STT_"^ACTIVE^DISCONTINUED^EXPIRED^HOLD^INCOMPLETE^NON-VERIFIED^PENDING^RENEWED^UNRELEASED","^",$FIND("ADEHINPRU",STT)))
+11 ;
SET ;
+1 ;373
SET PSGOSTN=$$ENSTN^PSGMI(ST)
SET (PSGOFDN,PSGOSDN)=""
IF SD
SET PSGOSDN=$$ENDD^PSGMI(SD)_"^"_$$ENDTC2^PSGMI(SD)
+2 ;373
IF FD
SET PSGOFDN=$$ENDD^PSGMI(FD)_"^"_$$ENDTC2^PSGMI(FD)
+3 FOR X="PD","PDN","MR","MRN","ST","STN","SCH","SI","SD","SDN","FD","FDN","SM","HSM","PR","PRN","DO","AT"
SET @("PSG"_X)=@("PSGO"_X)
+4 KILL ^PS(53.45,PSJSYSP,1),^(2)
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
+5 SET $PIECE(^PS(53.45,PSJSYSP,2,0),"^",2)="53.4502P"
+6 QUIT
+7 ;
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 !,"Order Status: ",PSGSTAT,?37,"Entered By: ",PSGEBN,!,"--------------------------------------------------------------------------------"
+5 WRITE !?1,$SELECT($DATA(PSGEFN(1)):$EXTRACT(" *",PSGEFN(1)+1)_"(1)",1:" "),?16,"Drug: ",PSGPDN
+6 WRITE !?1,$SELECT($DATA(PSGEFN(2)):$EXTRACT(" *",PSGEFN(2)+1)_"(2)",1:" "),?6,"Dosage Ordered: ",PSGDO,?46,$SELECT($DATA(PSGEFN(12)):$EXTRACT(" *",PSGEFN(12)+1)_"(12)",1:" ")," Start: ",$PIECE(PSGSDN,"^",2)
+7 WRITE !?1,$SELECT($DATA(PSGEFN(3)):$EXTRACT(" *",PSGEFN(3)+1)_"(3)",1:" "),?11,"Med Route: ",PSGMRN,?46,$SELECT($DATA(PSGEFN(13)):$EXTRACT(" *",PSGEFN(13)+1)_"(13)",1:" ")," Stop: ",$PIECE(PSGFDN,"^",2)
+8 WRITE !?1,$SELECT($DATA(PSGEFN(4)):$EXTRACT(" *",PSGEFN(4)+1)_"(4)",1:" "),?7,"Schedule Type: ",PSGSTN,?46,$SELECT($DATA(PSGEFN(14)):$EXTRACT(" *",PSGEFN(14)+1)_"(14)",1:" ")," Self Med: ",$PIECE("NO^YES","^",PSGSM+1)
IF PSGSM
IF PSGHSM
WRITE " (HS)"
+9 WRITE !?1,$SELECT($DATA(PSGEFN(5)):$EXTRACT(" *",PSGEFN(5)+1)_"(5)",1:" "),?12,"Schedule: ",PSGSCH
+10 WRITE !?1,$SELECT($DATA(PSGEFN(6)):$EXTRACT(" *",PSGEFN(6)+1)_"(6)",1:" "),?9,"Admin Times: ",PSGAT
+11 WRITE !?1,$SELECT($DATA(PSGEFN(7)):$EXTRACT(" *",PSGEFN(7)+1)_"(7)",1:" "),?12,"Provider: ",PSGPRN
+12 WRITE !?1,$SELECT($DATA(PSGEFN(8)):$EXTRACT(" *",PSGEFN(8)+1)_"(8)",1:" ")," Special Instructions: "
IF PSGSI]""
FOR Q=1:1:$LENGTH(PSGSI," ")
SET QQ=$PIECE(PSGSI," ",Q)
if $LENGTH(QQ)+$X>79
WRITE !?28
WRITE QQ," "
+13 WRITE !!?1,$SELECT($DATA(PSGEFN(9)):$EXTRACT(" *",PSGEFN(9)+1)_"(9)",1:" ")," Dispense Drug",?48,"U/D",?60,"Inactive Date",!,"-------------------------------------------------------------------------------"
+14 FOR Q=0:0
SET Q=$ORDER(^PS(53.45,PSJSYSP,2,Q))
if 'Q
QUIT
SET ND=$GET(^(Q,0))
Begin DoDot:1
+15 SET D=$PIECE(ND,"^")
SET PSGID=$PIECE(ND,"^",3)
IF PSGID
SET PSGID=$$ENDTC^PSGMI(PSGID)
+16 SET D=$SELECT(D="":"NOT FOUND",'$DATA(^PSDRUG(D,0)):D,$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:D_";PSDRUG(")
WRITE !?6,D,?48,$SELECT($PIECE(ND,"^",2):$PIECE(ND,"^",2),1:1)
if PSGID
WRITE ?60,PSGID
End DoDot:1
+17 WRITE !!,$SELECT($DATA(PSGEFN(10)):$EXTRACT(" *",PSGEFN(10)+1)_"(10)",1:" ")," Comments:"
FOR Q=0:0
SET Q=$ORDER(^PS(53.45,PSJSYSP,1,Q))
if 'Q
QUIT
SET Y=" "_$GET(^(Q,0))
FOR Y1=2:1
SET Y2=$PIECE(Y," ",Y1)
if Y2=""
QUIT
if $LENGTH(Y2)+$X>79
WRITE !?2
WRITE " ",Y2
+18 WRITE !!,$SELECT($DATA(PSGEFN(11)):$EXTRACT(" *",PSGEFN(11)+1)_"(11)",1:" ")," Provider Comments:"
+19 IF $GET(PSGORD)
Begin DoDot:1
+20 IF $DATA(^PS(53.1,+PSGORD,12,1))
FOR Q=0:0
SET Q=$ORDER(^PS(53.1,+PSGORD,12,Q))
if 'Q
QUIT
WRITE !?2,$GET(^(Q,0))
QUIT
+21 IF $DATA(^PS(53.1,+PSGORD,6))
WRITE !?2,$GET(^(6))
End DoDot:1
+22 KILL Q,Y,Y1,Y2
+23 QUIT
+24 ;
ENKILL ;
+1 KILL PSGAT,PSGEB,PSGFD,PSGHSM,PSGNEFD,PSGNESD,PSGOEEF,PSGOEER,PSGOFD,PSGOHSM,PSGOMR,PSGOMRN,PSGOPD,PSGOPDN,PSGOPR,PSGOSCH,PSGOSD,PSGOSM,PSGOST,PSGPD,PSGPDN,PSGPR,PSGSD,PSGSM
QUIT
HILIGHT ;
+1 ;
5 ;;3,46,34
7 ;;4,7,45
8 ;;8,5,80
10 ;;2,46,34
25 ;;3,46,34
26 ;;6,12,56
39 ;;6,9,71
40 ;;
66 ;;9,5,80
101 ;;1,6,74
109 ;;2,6,40
