- 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 Feb 18, 2025@23:28:32 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
