- 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
