PSGVW ;BIR/CML3-EXPANDED VIEW OF AN ORDER ;17 SEP 97 / 1:41 PM
;;5.0; INPATIENT MEDICATIONS ;**50,58,85,80,104,110**;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 ES^ORX8 is supported by DBIA# 3632.
;
EN1 ;
S PSGORD=^TMP("PSJON",$J,PSGOE2)
;
EN2 ;
I PSGORD=+PSGORD N PSGO,PSGO1 S PSGO=PSGORD,PSGO1=0 F S PSGO1=$O(^PS(53.1,"ACX",PSGO,PSGO1)) Q:'PSGO1 Q:$G(PSGOEA)["^" S PSGORD=PSGO1_"P" D S PSGORD=""
. D EN21 K CONT D Q:$G(PSGOEA)["^"
.. W !!,"Press RETURN to continue or '^' to exit: " R CONT:DTIME W @IOF S:CONT["^" PSGOEA="^",PSGPR=1,PSJPR=1
I PSGORD="" S PSGOEA="^" Q
EN21 ;
K ^PS(53.45,PSJSYSP,2)
N ESIG,PSJ21
S NF=$S(PSGORD["P":1,PSGORD["N":1,1:0)
S (FL,Y)="",$P(FL,"-",71)="",F="^PS("_$S(NF:"53.1,",1:"55,"_PSGP_",5,")_+PSGORD_","
S PN=$G(PSGP(0)) S:PN="" PN=$P($G(^DPT(PSGP,0)),"^")
; the naked reference on the line below refers to the full reference created by indirect reference to F_ON, where F may refer to ^PS(53.1 or the IV or UD multiple ^PS(55
S OD=$G(@(F_"0)")),STAT=$P(OD,U,9),PSJ21=$P(OD,U,21),PDRG=$G(^(.2)),INS=$G(^(.3)),AT=$G(^(2)),ND4=$G(^(4)),EB=$P(ND4,"^",7) S:'NF XU=$G(^(5)) S X=$P($G(^(6)),"^"),SIG=$G(^(6.5)),DO=$G(^(1,1,0))
S PR=$P(OD,"^",2),MR=$P(OD,"^",3),SM=$P(OD,"^",5),HSM=$P(OD,"^",6),SCT=$S(PSGORD'["P":$P(OD,"^",7),1:""),ST=$P(OD,"^",9),(PSGLI,LID)=$P(OD,"^",16),OD=$P(OD,"^",14),DO=$P(PDRG,"^",2),ESIG=$P(PDRG,"^",3),PDRG=+PDRG
L S SCH=$P(AT,"^"),STD=$S(STAT'["P":$P(AT,"^",2),1:""),FD=$S(STAT'["P":$P(AT,"^",4),1:""),FQC=$P(AT,"^",6),AT=$P(AT,"^",5) I FQC="D",AT="" S AT=$E($P(STD,".",2)_"0000",1,4)
S PRI=$S('PR:0,1:$P($G(^VA(200,PR,"PS")),"^",4)),DRGI=$S('PDRG:0,1:$P($G(^PS(50.7,PDRG,0)),"^",4)),PR=$$ENNPN^PSGMI(PR) S:PRI PRI=PRI'>DT S:DRGI DRGI=DRGI'>DT
I PSJ21]"",$L($T(ES^ORX8)) N ESIG1 S ESIG1=$$ES^ORX8(+PSJ21_";1") S:ESIG1=1 ESIG="ES"
S PR=PR_$S(ESIG]"":" ["_$$LOW^XLFSTR(ESIG)_"]",1:"")
S DRG=$$OIDF^PSJLMUT1(+PDRG) S SI=$S(X]"":$$ENSET^PSGSICHK(X),1:"")
F Q="FD","LID","OD","STD" S @Q=$$ENDTC^PSGMI(@Q)
Q:$D(PSJLM)
;
WRT ;
Q:($G(@(F_"0)"))="")
W !! W:'$D(PSGVWA) ?5,FL,! W "Patient: ",PN
W ?47,"Status: " I ST["D" W "DISCONTINUED",$S(ST["E":" (EDIT)",ST["R":" (RENEWAL)",1:"")
E W $S(ST="E":"EXPIRED",$P($G(@(F_"0)")),U,27)="R":"RENEWED",ST="":"NOT FOUND",ST="RE":"REINSTATED",1:$P(ST_"^ACTIVE^HOLD^INCOMPLETE^NON-VERIFIED^PENDING^UNRELEASED","^",$F("AHINPU",ST)))
W !,"Orderable Item: ",DRG
W !?2,"Instructions: ",INS
W !,"Dosage Ordered: ",DO
S PSJDUR="" I $G(PSGRDTX) S PSJDUR=$$FMTDUR^PSJLIVMD($P($G(PSGRDTX),U,2))
I $G(PSGORD),($G(PSJDUR)="") S P=$S(PSGORD["U":5,1:-1) S PSJDUR=$$GETDUR^PSJLIVMD(PSGP,+PSGORD,P)
W !?6,"Duration: ",PSJDUR
W ?48,"Start: ",STD
W !?5,"Med Route: ",$S(MR:$S($D(^PS(51.2,+MR,0)):$P(^(0),"^")_$S($P(^(0),"^",3)]"":" ("_$P(^(0),"^",3)_")",1:""),1:MR),1:"NOT FOUND")
N RNDT,PSGLRN S PSGLRN=$$LASTREN^PSJLMPRI(PSGP,PSGORD) I PSGLRN S RNDT=$$ENDTC^PSGMI(+PSGLRN) W ?46,"Renewed: ",RNDT
W !,$$BCMALG^PSJUTL2(PSGP,PSGORD)
W ?49,"Stop: ",FD
I $G(PSGORD),($G(PSJDUR)="") S P=$S(PSGORD["U":5,1:-1) S PSJDUR=$$GETDUR^PSJLIVMD(PSGP,+PSGORD,P)
W !?1,"Schedule Type: ",$$ENSTN^PSGMI(SCT)
W !?6,"Schedule: ",$S(SCH="":"NOT FOUND",$L(SCH)>27:$E(SCH,1,24)_"...",1:SCH)
W !?3,$S(AT&("P"'[SCT):"Admin Times: "_AT,1:"(No Admin Times)"),!?6,"Provider: ",PR
I SI]"" W !,"Special Instructions: " F Q=1:1:$L(SI," ") S QQ=$P(SI," ",Q) W:$L(QQ)+$X>79 !?2 W QQ," "
W !?48,"Units",?56,"Units",?64,"Inactive",!," Dispense Drugs",?43,"U/D",?48,"Disp'd",?56,"Ret'd",?64,"Date",!,FL,$E(FL,1,10)
; the naked reference on the line below refers to the full reference created by indirect reference to F_ON, where F may refer to ^PS(53.1 or the IV or UD multiple ^PS(55
F X=0:0 S X=$O(@(F_"1,"_X_")")) Q:'X S DRG=$G(^(X,0)) I DRG]"" D ;
.S UD=$P(DRG,"^",2),D=$P(DRG,"^",6)+$P(DRG,"^",10)+$P(DRG,"^",12),R=+$P(DRG,"^",7),Y=$P(DRG,"^",3),DRG=$P(DRG,"^") I Y S Y=$E($$ENDTC^PSGMI(Y),1,8)
.W !?1,$$ENDDN^PSGMI(DRG),?43,$S(UD:UD,1:1),?48,D,?56,R W:Y ?64,Y Q
; the naked reference on the two lines below refers to the full reference created by indirect reference to F_ON, where F may refer to ^PS(53.1 or the IV or UD multiple ^PS(55
I $O(@(F_"12,0)")) W !!,"Provider Comments:" F Q=0:0 S Q=$O(@(F_"12,"_Q_")")) Q:'Q N Y S Y=^(Q,0) W !,Y
I $O(@(F_"3,0)")) W !!,"Comments:" F Q=0:0 S Q=$O(@(F_"3,"_Q_")")) Q:'Q W !,^(Q,0)
ACTFLG W ! S AT="",Y="12,13,D,18,19,H1,22,23,H0,15,16,R" F X=1:3:12 I $P(ND4,"^",$P(Y,",",X)),$P(ND4,"^",$P(Y,",",X+1)) S AT=$P(Y,",",X+2) Q
I AT="",'$P(ND4,"^",$S($P(PSJSYSU,";",3)>1:3,1:1)) S AT="V"_$S($P(ND4,"^",18):"H1",$P(ND4,"^",22):"H0",$P(ND4,"^",15):"R",1:"")
W:AT]"" !,"ORDER ",$S(AT["V":"NOT VERIFIED"_$S($P(AT,"V",2)="":"",1:" ("_$S(AT["H1":"ON HOLD",AT["H0":"OFF HOLD",1:"RENEWAL")_")"),1:"MARKED TO BE "_$S(AT["D":"CANCELLED",AT["H1":"PLACED ON HOLD",AT["H0":"TAKEN OFF OF HOLD",1:"RENEWED"))
I AT'["V",AT["H1",$D(^PS(55,PSGP,5.1)) S AT=^(5.1) I $P(AT,"^",7),$P(AT,"^",10)]"" W " (",$P(AT,"^",10),")"
W !,"Self Med: " I SM W "SELF MED" W:HSM " (HOSPITAL SUPPLIED)"
I 'SM&('HSM) W "NO"
W !!,"Entry By: ",$$ENNPN^PSGMI(EB),?52,"Entry Date: ",LID
I $G(PSGLRN) W !,"Renewed By: "_$$ENNPN^PSGMI($P(PSGLRN,"^",2))
W:DRGI !!?3,"(THE ORDERABLE ITEM IS CURRENTLY LISTED AS INACTIVE.)" I PRI W:'DRGI ! W !?3,"(PROVIDER IS CURRENTLY LISTED AS INACTIVE.)"
;
DONE ;
K AND,D,DRG1,DRG2,AT,DO,DRG,EB,F,FD,FL,HSM,INS,LID,MR,ND4,OD,PN,PR,PSGID,PSGOD,R,SCH,SCT,SI,SIG,SM,ST,STD,UD,X,XU,Y Q
Q
PSGVW ;BIR/CML3-EXPANDED VIEW OF AN ORDER ;17 SEP 97 / 1:41 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**50,58,85,80,104,110**;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 ES^ORX8 is supported by DBIA# 3632.
+7 ;
EN1 ;
+1 SET PSGORD=^TMP("PSJON",$JOB,PSGOE2)
+2 ;
EN2 ;
+1 IF PSGORD=+PSGORD
NEW PSGO,PSGO1
SET PSGO=PSGORD
SET PSGO1=0
FOR
SET PSGO1=$ORDER(^PS(53.1,"ACX",PSGO,PSGO1))
IF 'PSGO1
QUIT
IF $GET(PSGOEA)["^"
QUIT
SET PSGORD=PSGO1_"P"
Begin DoDot:1
+2 DO EN21
KILL CONT
Begin DoDot:2
+3 WRITE !!,"Press RETURN to continue or '^' to exit: "
READ CONT:DTIME
WRITE @IOF
IF CONT["^"
SET PSGOEA="^"
SET PSGPR=1
SET PSJPR=1
End DoDot:2
IF $GET(PSGOEA)["^"
QUIT
End DoDot:1
SET PSGORD=""
+4 IF PSGORD=""
SET PSGOEA="^"
QUIT
EN21 ;
+1 KILL ^PS(53.45,PSJSYSP,2)
+2 NEW ESIG,PSJ21
+3 SET NF=$SELECT(PSGORD["P":1,PSGORD["N":1,1:0)
+4 SET (FL,Y)=""
SET $PIECE(FL,"-",71)=""
SET F="^PS("_$SELECT(NF:"53.1,",1:"55,"_PSGP_",5,")_+PSGORD_","
+5 SET PN=$GET(PSGP(0))
IF PN=""
SET PN=$PIECE($GET(^DPT(PSGP,0)),"^")
+6 ; the naked reference on the line below refers to the full reference created by indirect reference to F_ON, where F may refer to ^PS(53.1 or the IV or UD multiple ^PS(55
+7 SET OD=$GET(@(F_"0)"))
SET STAT=$PIECE(OD,U,9)
SET PSJ21=$PIECE(OD,U,21)
SET PDRG=$GET(^(.2))
SET INS=$GET(^(.3))
SET AT=$GET(^(2))
SET ND4=$GET(^(4))
SET EB=$PIECE(ND4,"^",7)
IF 'NF
SET XU=$GET(^(5))
SET X=$PIECE($GET(^(6)),"^")
SET SIG=$GET(^(6.5))
SET DO=$GET(^(1,1,0))
+8 SET PR=$PIECE(OD,"^",2)
SET MR=$PIECE(OD,"^",3)
SET SM=$PIECE(OD,"^",5)
SET HSM=$PIECE(OD,"^",6)
SET SCT=$SELECT(PSGORD'["P":$PIECE(OD,"^",7),1:"")
SET ST=$PIECE(OD,"^",9)
SET (PSGLI,LID)=$PIECE(OD,"^",16)
SET OD=$PIECE(OD,"^",14)
SET DO=$PIECE(PDRG,"^",2)
SET ESIG=$PIECE(PDRG,"^",3)
SET PDRG=+PDRG
L SET SCH=$PIECE(AT,"^")
SET STD=$SELECT(STAT'["P":$PIECE(AT,"^",2),1:"")
SET FD=$SELECT(STAT'["P":$PIECE(AT,"^",4),1:"")
SET FQC=$PIECE(AT,"^",6)
SET AT=$PIECE(AT,"^",5)
IF FQC="D"
IF AT=""
SET AT=$EXTRACT($PIECE(STD,".",2)_"0000",1,4)
+1 SET PRI=$SELECT('PR:0,1:$PIECE($GET(^VA(200,PR,"PS")),"^",4))
SET DRGI=$SELECT('PDRG:0,1:$PIECE($GET(^PS(50.7,PDRG,0)),"^",4))
SET PR=$$ENNPN^PSGMI(PR)
IF PRI
SET PRI=PRI'>DT
IF DRGI
SET DRGI=DRGI'>DT
+2 IF PSJ21]""
IF $LENGTH($TEXT(ES^ORX8))
NEW ESIG1
SET ESIG1=$$ES^ORX8(+PSJ21_";1")
IF ESIG1=1
SET ESIG="ES"
+3 SET PR=PR_$SELECT(ESIG]"":" ["_$$LOW^XLFSTR(ESIG)_"]",1:"")
+4 SET DRG=$$OIDF^PSJLMUT1(+PDRG)
SET SI=$SELECT(X]"":$$ENSET^PSGSICHK(X),1:"")
+5 FOR Q="FD","LID","OD","STD"
SET @Q=$$ENDTC^PSGMI(@Q)
+6 IF $DATA(PSJLM)
QUIT
+7 ;
WRT ;
+1 IF ($GET(@(F_"0)"))="")
QUIT
+2 WRITE !!
IF '$DATA(PSGVWA)
WRITE ?5,FL,!
WRITE "Patient: ",PN
+3 WRITE ?47,"Status: "
IF ST["D"
WRITE "DISCONTINUED",$SELECT(ST["E":" (EDIT)",ST["R":" (RENEWAL)",1:"")
+4 IF '$TEST
WRITE $SELECT(ST="E":"EXPIRED",$PIECE($GET(@(F_"0)")),U,27)="R":"RENEWED",ST="":"NOT FOUND",ST="RE":"REINSTATED",1:$PIECE(ST_"^ACTIVE^HOLD^INCOMPLETE^NON-VERIFIED^PENDING^UNRELEASED","^",$FIND("AHINPU",ST)))
+5 WRITE !,"Orderable Item: ",DRG
+6 WRITE !?2,"Instructions: ",INS
+7 WRITE !,"Dosage Ordered: ",DO
+8 SET PSJDUR=""
IF $GET(PSGRDTX)
SET PSJDUR=$$FMTDUR^PSJLIVMD($PIECE($GET(PSGRDTX),U,2))
+9 IF $GET(PSGORD)
IF ($GET(PSJDUR)="")
SET P=$SELECT(PSGORD["U":5,1:-1)
SET PSJDUR=$$GETDUR^PSJLIVMD(PSGP,+PSGORD,P)
+10 WRITE !?6,"Duration: ",PSJDUR
+11 WRITE ?48,"Start: ",STD
+12 WRITE !?5,"Med Route: ",$SELECT(MR:$SELECT($DATA(^PS(51.2,+MR,0)):$PIECE(^(0),"^")_$SELECT($PIECE(^(0),"^",3)]"":" ("_$PIECE(^(0),"^",3)_")",1:""),1:MR),1:"NOT FOUND")
+13 NEW RNDT,PSGLRN
SET PSGLRN=$$LASTREN^PSJLMPRI(PSGP,PSGORD)
IF PSGLRN
SET RNDT=$$ENDTC^PSGMI(+PSGLRN)
WRITE ?46,"Renewed: ",RNDT
+14 WRITE !,$$BCMALG^PSJUTL2(PSGP,PSGORD)
+15 WRITE ?49,"Stop: ",FD
+16 IF $GET(PSGORD)
IF ($GET(PSJDUR)="")
SET P=$SELECT(PSGORD["U":5,1:-1)
SET PSJDUR=$$GETDUR^PSJLIVMD(PSGP,+PSGORD,P)
+17 WRITE !?1,"Schedule Type: ",$$ENSTN^PSGMI(SCT)
+18 WRITE !?6,"Schedule: ",$SELECT(SCH="":"NOT FOUND",$LENGTH(SCH)>27:$EXTRACT(SCH,1,24)_"...",1:SCH)
+19 WRITE !?3,$SELECT(AT&("P"'[SCT):"Admin Times: "_AT,1:"(No Admin Times)"),!?6,"Provider: ",PR
+20 IF SI]""
WRITE !,"Special Instructions: "
FOR Q=1:1:$LENGTH(SI," ")
SET QQ=$PIECE(SI," ",Q)
IF $LENGTH(QQ)+$X>79
WRITE !?2
WRITE QQ," "
+21 WRITE !?48,"Units",?56,"Units",?64,"Inactive",!," Dispense Drugs",?43,"U/D",?48,"Disp'd",?56,"Ret'd",?64,"Date",!,FL,$EXTRACT(FL,1,10)
+22 ; the naked reference on the line below refers to the full reference created by indirect reference to F_ON, where F may refer to ^PS(53.1 or the IV or UD multiple ^PS(55
+23 ;
FOR X=0:0
SET X=$ORDER(@(F_"1,"_X_")"))
IF 'X
QUIT
SET DRG=$GET(^(X,0))
IF DRG]""
Begin DoDot:1
+24 SET UD=$PIECE(DRG,"^",2)
SET D=$PIECE(DRG,"^",6)+$PIECE(DRG,"^",10)+$PIECE(DRG,"^",12)
SET R=+$PIECE(DRG,"^",7)
SET Y=$PIECE(DRG,"^",3)
SET DRG=$PIECE(DRG,"^")
IF Y
SET Y=$EXTRACT($$ENDTC^PSGMI(Y),1,8)
+25 WRITE !?1,$$ENDDN^PSGMI(DRG),?43,$SELECT(UD:UD,1:1),?48,D,?56,R
IF Y
WRITE ?64,Y
QUIT
End DoDot:1
+26 ; the naked reference on the two lines below refers to the full reference created by indirect reference to F_ON, where F may refer to ^PS(53.1 or the IV or UD multiple ^PS(55
+27 IF $ORDER(@(F_"12,0)"))
WRITE !!,"Provider Comments:"
FOR Q=0:0
SET Q=$ORDER(@(F_"12,"_Q_")"))
IF 'Q
QUIT
NEW Y
SET Y=^(Q,0)
WRITE !,Y
+28 IF $ORDER(@(F_"3,0)"))
WRITE !!,"Comments:"
FOR Q=0:0
SET Q=$ORDER(@(F_"3,"_Q_")"))
IF 'Q
QUIT
WRITE !,^(Q,0)
ACTFLG WRITE !
SET AT=""
SET Y="12,13,D,18,19,H1,22,23,H0,15,16,R"
FOR X=1:3:12
IF $PIECE(ND4,"^",$PIECE(Y,",",X))
IF $PIECE(ND4,"^",$PIECE(Y,",",X+1))
SET AT=$PIECE(Y,",",X+2)
QUIT
+1 IF AT=""
IF '$PIECE(ND4,"^",$SELECT($PIECE(PSJSYSU,";",3)>1:3,1:1))
SET AT="V"_$SELECT($PIECE(ND4,"^",18):"H1",$PIECE(ND4,"^",22):"H0",$PIECE(ND4,"^",15):"R",1:"")
+2 IF AT]""
WRITE !,"ORDER ",$SELECT(AT["V":"NOT VERIFIED"_$SELECT($PIECE(AT,"V",2)="":"",1:" ("_$SELECT(AT["H1":"ON HOLD",AT["H0":"OFF HOLD",1:"RENEWAL")_")"),1:"MARKED TO BE "_...
... $SELECT(AT["D":"CANCELLED",AT["H1":"PLACED ON HOLD",AT["H0":"TAKEN OFF OF HOLD",1:"RENEWED"))
+3 IF AT'["V"
IF AT["H1"
IF $DATA(^PS(55,PSGP,5.1))
SET AT=^(5.1)
IF $PIECE(AT,"^",7)
IF $PIECE(AT,"^",10)]""
WRITE " (",$PIECE(AT,"^",10),")"
+4 WRITE !,"Self Med: "
IF SM
WRITE "SELF MED"
IF HSM
WRITE " (HOSPITAL SUPPLIED)"
+5 IF 'SM&('HSM)
WRITE "NO"
+6 WRITE !!,"Entry By: ",$$ENNPN^PSGMI(EB),?52,"Entry Date: ",LID
+7 IF $GET(PSGLRN)
WRITE !,"Renewed By: "_$$ENNPN^PSGMI($PIECE(PSGLRN,"^",2))
+8 IF DRGI
WRITE !!?3,"(THE ORDERABLE ITEM IS CURRENTLY LISTED AS INACTIVE.)"
IF PRI
IF 'DRGI
WRITE !
WRITE !?3,"(PROVIDER IS CURRENTLY LISTED AS INACTIVE.)"
+9 ;
DONE ;
+1 KILL AND,D,DRG1,DRG2,AT,DO,DRG,EB,F,FD,FL,HSM,INS,LID,MR,ND4,OD,PN,PR,PSGID,PSGOD,R,SCH,SCT,SI,SIG,SM,ST,STD,UD,X,XU,Y
QUIT
+2 QUIT
