ORCXPND4 ; SLC/MKB,MA - Expanded Display cont ;06/24/11 11:44
;;3.0;ORDER ENTRY/RESULTS REPORTING;**67,306**;Dec 17, 1997;Build 43
;
PL ; -- problem list
N ORPL,X,I,J,T,CNT,PROBLEM,II,CMTFLG,CNT1
D DETAIL^GMPLUTL2(+ID,.ORPL)
S PROBLEM=(LCNT+1)_U_ORPL("NARRATIVE") ; #^Provider Narrative
S J=1,X(J)=$P(PROBLEM,U,2),J=J+1
I $L($G(ORPL("SCTC")))!$L($G(ORPL("SCTD"))) D I 1
.I $P(ORPL("NARRATIVE")," (SCT")'=ORPL("SCTT") S X(J)=" SNOMED-CT: "_ORPL("SCTT"),J=J+1
.I $L($G(ORPL("DIAGNOSIS")))&(ORPL("DIAGNOSIS")'="799.9")&($L($G(ORPL("ICDD")))) S X(J)=" Primary ICD-9-CM: "_$G(ORPL("DIAGNOSIS"))_$$PAD^ORUTL($G(ORPL("DIAGNOSIS")),6)_" ["_$G(ORPL("ICDD"))_"]",J=J+1
E I $L($G(ORPL("VHATC")))!$L($G(ORPL("VHATD"))) D I 1
.I $P(ORPL("NARRATIVE")," (VHAT")'=ORPL("VHATT") S X(J)=" VHAT: "_ORPL("VHATT"),J=J+1
.I $L($G(ORPL("DIAGNOSIS")))&(ORPL("DIAGNOSIS")'="799.9")&($L($G(ORPL("ICDD")))) S X(J)=" Primary ICD-9-CM: "_$G(ORPL("DIAGNOSIS"))_$$PAD^ORUTL($G(ORPL("DIAGNOSIS")),6)_" ["_$G(ORPL("ICDD"))_"]",J=J+1
E I ORPL("DIAGNOSIS")'="799.9",$L($G(ORPL("ICDD"))) D
.N ICDD,I S ICDD=$$WRAP^ORU2($G(ORPL("ICDD")),65)
.F I=1:1:$L(ICDD,"|") S X(J)=$S(I=1:"ICD-9-CM TEXT: ",1:" ")_$P(ICDD,"|",I),J=J+1
I ORPL("ICD9MLTP")'="" F T=1:1:ORPL("ICD9MLTP") D
. S X(J)=$S(T=1:"Secondary ICD-9-CM: ",T>1:" : ")_$P($G(ORPL("ICD9MLTP",T)),U)_$$PAD^ORUTL($P($G(ORPL("ICD9MLTP",T)),U),6)_" ["_$P($G(ORPL("ICD9MLTP",T)),U,2)_"]",J=J+1
S X(J)=" ",J=J+1
S X(J)=" Onset: "_ORPL("ONSET"),X(J)=X(J)_$J("SC Condition: ",61-$L(X(J)))_ORPL("SC"),J=J+1
S X(J)=" Status: "_ORPL("STATUS")_$S($L(ORPL("PRIORITY")):"/"_ORPL("PRIORITY"),1:""),X(J)=X(J)_$J("Exposure: ",61-$L(X(J)))_$S('ORPL("EXPOSURE"):"NONE",1:ORPL("EXPOSURE",1)),J=J+1
S X(J)=" Provider: "_ORPL("PROVIDER"),J=J+1
S:ORPL("EXPOSURE")>1 X(J)=X(J)_$$REPEAT^XLFSTR(" ",61-$L(X(J)))_ORPL("EXPOSURE",2),J=J+1
S X(J)=" Clinic: "_ORPL("CLINIC"),J=J+1
S:ORPL("EXPOSURE")>2 X(J)=X(J)_$$REPEAT^XLFSTR(" ",61-$L(X(J)))_ORPL("EXPOSURE",3),J=J+1
PL1 S X(J)=" ",J=J+1
S X(J)=" Recorded: "_$P(ORPL("RECORDED"),U)_", by "_$P(ORPL("RECORDED"),U,2),J=J+1
S X(J)=" Entered: "_$P(ORPL("ENTERED"),U)_", by "_$P(ORPL("ENTERED"),U,2),J=J+1
S X(J)=" Updated: "_ORPL("MODIFIED"),J=J+1
S X(J)=" ",J=J+1,X(J)="Comments: ",CMTFLG=J,CNT=J,J=J+1
S:ORPL("COMMENT")'>0 X(J)=" <None>",CNT=J
I ORPL("COMMENT") F I=1:1:ORPL("COMMENT") D
. S CNT=CNT+1,X(CNT)=$J($P(ORPL("COMMENT",I),U),8)_": "_$P(ORPL("COMMENT",I),U,3)
. S CNT=CNT+1,X(CNT)=" "_$P(ORPL("COMMENT",I),U,2)
S CNT=CNT+1,X(CNT)=" "
F I=1:1:CNT S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X(I)
D:$D(IORVON) SETVIDEO^ORCXPND(+PROBLEM,1,$L($P(PROBLEM,U,2)),IORVON,IORVOFF)
D:$D(IOUON) SETVIDEO^ORCXPND(CMTFLG,1,8,IOUON,IOUOFF)
PL2 ; Changes added to include PROBLEM LIST AUDIT TRAIL 8 Sep 99
S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="History:"
D:$D(IOUON) SETVIDEO^ORCXPND(LCNT,1,7,IOUON,IOUOFF)
I ORPL("AUDIT")=0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" <No Changes>" Q
I ORPL("AUDIT")>0 F II=1:1:ORPL("AUDIT") D COVPRT
Q
;
COVPRT ; This will convert GMPL("AUDIT") to printable format and write it
; out to ^TMP("ORXPND",$J)
N NODE,DATE,FLD,PROV,OLD,NEW,ROOT,CHNGE
S NODE=ORPL("AUDIT",II,0)
S DATE=$$DATE^ORCHTAB($P(NODE,U,3)),FLD=+$P(NODE,U),PROV=+$P(NODE,U,8)
S:'PROV PROV=$P(NODE,U,4) S PROV=$P($G(^VA(200,PROV,0)),U) ;Entr vs Prov
S OLD=$P(NODE,U,5),NEW=$P(NODE,U,6),LCNT=LCNT+1
I +FLD=1101 D Q
. S NODE=ORPL("AUDIT",II,1) ; old note
. S ^TMP("ORXPND",$J,LCNT,0)=$J(DATE,10)_": NOTE "_$$DATE^ORCHTAB($P(NODE,U,5))_" removed by "_PROV
. S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" "_$P(NODE,U,3)
I +FLD=1.02 D Q
. S CHNGE=$S(NEW="H":"removed",OLD="T":"verified",1:"placed back on list")
. S ^TMP("ORXPND",$J,LCNT,0)=$J(DATE,10)_": PROBLEM "_CHNGE_" by "_PROV
S ^TMP("ORXPND",$J,LCNT,0)=$J(DATE,10)_": "_$P(NODE,U,2)_" changed by "_PROV,LCNT=LCNT+1
I +FLD=.12 S ^TMP("ORXPND",$J,LCNT,0)=$J("from ",17)_$S(OLD="A":"ACTIVE",OLD="I":"INACTIVE",1:"UNKNOWN")_" to "_$S(NEW="A":"ACTIVE",NEW="I":"INACTIVE",1:"UNKNOWN") Q
I (+FLD=.13)!(+FLD=1.07) S ^TMP("ORXPND",$J,LCNT,0)=$J("from ",17)_$$DATE^ORCHTAB(OLD)_" to "_$$DATE^ORCHTAB(NEW) Q
I +FLD=1.14 S ^TMP("ORXPND",$J,LCNT,0)=$J("from ",17)_$S(OLD="A":"ACUTE",OLD="C":"CHRONIC",1:"UNSPECIFIED")_" to "_$S(NEW="A":"ACUTE",NEW="C":"CHRONIC",1:"UNSPECIFIED") Q
I +FLD=302 D Q
. ; if NEW value non-null, register change
. I NEW]"" D
. . S ^TMP("ORXPND",$J,LCNT,0)=$J("from ",17)_OLD,LCNT=LCNT+1
. . S ^TMP("ORXPND",$J,LCNT,0)=$J("to ",17)_NEW
. ; otherwise, register removal
. E S ^TMP("ORXPND",$J,LCNT,0)=$J(OLD_$$PAD^ORUTL(OLD,6),23)_" removed."
I +FLD>1.09 S ^TMP("ORXPND",$J,LCNT,0)=$J("from ",17)_$S(+OLD:"YES",OLD=0:"NO",1:"UNKNOWN")_" to "_$S(+NEW:"YES",NEW=0:"NO",1:"UNKNOWN") Q
I "^.01^.05^1.01^1.04^1.05^1.06^1.08^"[(U_+FLD_U) D
. S ROOT=$S(+FLD=.01:"ICD9(",+FLD=.05:"AUTNPOV(",+FLD=1.01:"LEX(757.01,",(+FLD=1.04)!(+FLD=1.05):"VA(200,",+FLD=1.06:"DIC(49,",+FLD=1.08:"SC(",1:"") Q:ROOT=""
. S ^TMP("ORXPND",$J,LCNT,0)=$J("from ",17)_$S(OLD:$P(@(U_ROOT_OLD_",0)"),U),1:"UNSPECIFIED")
. S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$J("to ",17)_$S(NEW:$P(@(U_ROOT_NEW_",0)"),U),1:"UNSPECIFIED")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCXPND4 5385 printed Sep 23, 2025@20:05:28 Page 2
ORCXPND4 ; SLC/MKB,MA - Expanded Display cont ;06/24/11 11:44
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**67,306**;Dec 17, 1997;Build 43
+2 ;
PL ; -- problem list
+1 NEW ORPL,X,I,J,T,CNT,PROBLEM,II,CMTFLG,CNT1
+2 DO DETAIL^GMPLUTL2(+ID,.ORPL)
+3 ; #^Provider Narrative
SET PROBLEM=(LCNT+1)_U_ORPL("NARRATIVE")
+4 SET J=1
SET X(J)=$PIECE(PROBLEM,U,2)
SET J=J+1
+5 IF $LENGTH($GET(ORPL("SCTC")))!$LENGTH($GET(ORPL("SCTD")))
Begin DoDot:1
+6 IF $PIECE(ORPL("NARRATIVE")," (SCT")'=ORPL("SCTT")
SET X(J)=" SNOMED-CT: "_ORPL("SCTT")
SET J=J+1
+7 IF $LENGTH($GET(ORPL("DIAGNOSIS")))&(ORPL("DIAGNOSIS")'="799.9")&($LENGTH($GET(ORPL("ICDD"))))
SET X(J)=" Primary ICD-9-CM: "_$GET(ORPL("DIAGNOSIS"))_$$PAD^ORUTL($GET(ORPL("DIAGNOSIS")),6)_" ["_$GET(ORPL("ICDD"))_"]"
SET J=J+1
End DoDot:1
IF 1
+8 IF '$TEST
IF $LENGTH($GET(ORPL("VHATC")))!$LENGTH($GET(ORPL("VHATD")))
Begin DoDot:1
+9 IF $PIECE(ORPL("NARRATIVE")," (VHAT")'=ORPL("VHATT")
SET X(J)=" VHAT: "_ORPL("VHATT")
SET J=J+1
+10 IF $LENGTH($GET(ORPL("DIAGNOSIS")))&(ORPL("DIAGNOSIS")'="799.9")&($LENGTH($GET(ORPL("ICDD"))))
SET X(J)=" Primary ICD-9-CM: "_$GET(ORPL("DIAGNOSIS"))_$$PAD^ORUTL($GET(ORPL("DIAGNOSIS")),6)_" ["_$GET(ORPL("ICDD"))_"]"
SET J=J+1
End DoDot:1
IF 1
+11 IF '$TEST
IF ORPL("DIAGNOSIS")'="799.9"
IF $LENGTH($GET(ORPL("ICDD")))
Begin DoDot:1
+12 NEW ICDD,I
SET ICDD=$$WRAP^ORU2($GET(ORPL("ICDD")),65)
+13 FOR I=1:1:$LENGTH(ICDD,"|")
SET X(J)=$SELECT(I=1:"ICD-9-CM TEXT: ",1:" ")_$PIECE(ICDD,"|",I)
SET J=J+1
End DoDot:1
+14 IF ORPL("ICD9MLTP")'=""
FOR T=1:1:ORPL("ICD9MLTP")
Begin DoDot:1
+15 SET X(J)=$SELECT(T=1:"Secondary ICD-9-CM: ",T>1:" : ")_$PIECE($GET(ORPL("ICD9MLTP",T)),U)_$$PAD^ORUTL($PIECE($GET(ORPL("ICD9MLTP",T)),U),6)_" ["_$PIECE($GET(ORPL("ICD9MLTP",T)),U,2)_"]"
SET J=J+1
End DoDot:1
+16 SET X(J)=" "
SET J=J+1
+17 SET X(J)=" Onset: "_ORPL("ONSET")
SET X(J)=X(J)_$JUSTIFY("SC Condition: ",61-$LENGTH(X(J)))_ORPL("SC")
SET J=J+1
+18 SET X(J)=" Status: "_ORPL("STATUS")_$SELECT($LENGTH(ORPL("PRIORITY")):"/"_ORPL("PRIORITY"),1:"")
SET X(J)=X(J)_$JUSTIFY("Exposure: ",61-$LENGTH(X(J)))_$SELECT('ORPL("EXPOSURE"):"NONE",1:ORPL("EXPOSURE",1))
SET J=J+1
+19 SET X(J)=" Provider: "_ORPL("PROVIDER")
SET J=J+1
+20 if ORPL("EXPOSURE")>1
SET X(J)=X(J)_$$REPEAT^XLFSTR(" ",61-$LENGTH(X(J)))_ORPL("EXPOSURE",2)
SET J=J+1
+21 SET X(J)=" Clinic: "_ORPL("CLINIC")
SET J=J+1
+22 if ORPL("EXPOSURE")>2
SET X(J)=X(J)_$$REPEAT^XLFSTR(" ",61-$LENGTH(X(J)))_ORPL("EXPOSURE",3)
SET J=J+1
PL1 SET X(J)=" "
SET J=J+1
+1 SET X(J)=" Recorded: "_$PIECE(ORPL("RECORDED"),U)_", by "_$PIECE(ORPL("RECORDED"),U,2)
SET J=J+1
+2 SET X(J)=" Entered: "_$PIECE(ORPL("ENTERED"),U)_", by "_$PIECE(ORPL("ENTERED"),U,2)
SET J=J+1
+3 SET X(J)=" Updated: "_ORPL("MODIFIED")
SET J=J+1
+4 SET X(J)=" "
SET J=J+1
SET X(J)="Comments: "
SET CMTFLG=J
SET CNT=J
SET J=J+1
+5 if ORPL("COMMENT")'>0
SET X(J)=" <None>"
SET CNT=J
+6 IF ORPL("COMMENT")
FOR I=1:1:ORPL("COMMENT")
Begin DoDot:1
+7 SET CNT=CNT+1
SET X(CNT)=$JUSTIFY($PIECE(ORPL("COMMENT",I),U),8)_": "_$PIECE(ORPL("COMMENT",I),U,3)
+8 SET CNT=CNT+1
SET X(CNT)=" "_$PIECE(ORPL("COMMENT",I),U,2)
End DoDot:1
+9 SET CNT=CNT+1
SET X(CNT)=" "
+10 FOR I=1:1:CNT
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=X(I)
+11 if $DATA(IORVON)
DO SETVIDEO^ORCXPND(+PROBLEM,1,$LENGTH($PIECE(PROBLEM,U,2)),IORVON,IORVOFF)
+12 if $DATA(IOUON)
DO SETVIDEO^ORCXPND(CMTFLG,1,8,IOUON,IOUOFF)
PL2 ; Changes added to include PROBLEM LIST AUDIT TRAIL 8 Sep 99
+1 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)="History:"
+2 if $DATA(IOUON)
DO SETVIDEO^ORCXPND(LCNT,1,7,IOUON,IOUOFF)
+3 IF ORPL("AUDIT")=0
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=" <No Changes>"
QUIT
+4 IF ORPL("AUDIT")>0
FOR II=1:1:ORPL("AUDIT")
DO COVPRT
+5 QUIT
+6 ;
COVPRT ; This will convert GMPL("AUDIT") to printable format and write it
+1 ; out to ^TMP("ORXPND",$J)
+2 NEW NODE,DATE,FLD,PROV,OLD,NEW,ROOT,CHNGE
+3 SET NODE=ORPL("AUDIT",II,0)
+4 SET DATE=$$DATE^ORCHTAB($PIECE(NODE,U,3))
SET FLD=+$PIECE(NODE,U)
SET PROV=+$PIECE(NODE,U,8)
+5 ;Entr vs Prov
if 'PROV
SET PROV=$PIECE(NODE,U,4)
SET PROV=$PIECE($GET(^VA(200,PROV,0)),U)
+6 SET OLD=$PIECE(NODE,U,5)
SET NEW=$PIECE(NODE,U,6)
SET LCNT=LCNT+1
+7 IF +FLD=1101
Begin DoDot:1
+8 ; old note
SET NODE=ORPL("AUDIT",II,1)
+9 SET ^TMP("ORXPND",$JOB,LCNT,0)=$JUSTIFY(DATE,10)_": NOTE "_$$DATE^ORCHTAB($PIECE(NODE,U,5))_" removed by "_PROV
+10 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=" "_$PIECE(NODE,U,3)
End DoDot:1
QUIT
+11 IF +FLD=1.02
Begin DoDot:1
+12 SET CHNGE=$SELECT(NEW="H":"removed",OLD="T":"verified",1:"placed back on list")
+13 SET ^TMP("ORXPND",$JOB,LCNT,0)=$JUSTIFY(DATE,10)_": PROBLEM "_CHNGE_" by "_PROV
End DoDot:1
QUIT
+14 SET ^TMP("ORXPND",$JOB,LCNT,0)=$JUSTIFY(DATE,10)_": "_$PIECE(NODE,U,2)_" changed by "_PROV
SET LCNT=LCNT+1
+15 IF +FLD=.12
SET ^TMP("ORXPND",$JOB,LCNT,0)=$JUSTIFY("from ",17)_$SELECT(OLD="A":"ACTIVE",OLD="I":"INACTIVE",1:"UNKNOWN")_" to "_$SELECT(NEW="A":"ACTIVE",NEW="I":"INACTIVE",1:"UNKNOWN")
QUIT
+16 IF (+FLD=.13)!(+FLD=1.07)
SET ^TMP("ORXPND",$JOB,LCNT,0)=$JUSTIFY("from ",17)_$$DATE^ORCHTAB(OLD)_" to "_$$DATE^ORCHTAB(NEW)
QUIT
+17 IF +FLD=1.14
SET ^TMP("ORXPND",$JOB,LCNT,0)=$JUSTIFY("from ",17)_$SELECT(OLD="A":"ACUTE",OLD="C":"CHRONIC",1:"UNSPECIFIED")_" to "_$SELECT(NEW="A":"ACUTE",NEW="C":"CHRONIC",1:"UNSPECIFIED")
QUIT
+18 IF +FLD=302
Begin DoDot:1
+19 ; if NEW value non-null, register change
+20 IF NEW]""
Begin DoDot:2
+21 SET ^TMP("ORXPND",$JOB,LCNT,0)=$JUSTIFY("from ",17)_OLD
SET LCNT=LCNT+1
+22 SET ^TMP("ORXPND",$JOB,LCNT,0)=$JUSTIFY("to ",17)_NEW
End DoDot:2
+23 ; otherwise, register removal
+24 IF '$TEST
SET ^TMP("ORXPND",$JOB,LCNT,0)=$JUSTIFY(OLD_$$PAD^ORUTL(OLD,6),23)_" removed."
End DoDot:1
QUIT
+25 IF +FLD>1.09
SET ^TMP("ORXPND",$JOB,LCNT,0)=$JUSTIFY("from ",17)_$SELECT(+OLD:"YES",OLD=0:"NO",1:"UNKNOWN")_" to "_$SELECT(+NEW:"YES",NEW=0:"NO",1:"UNKNOWN")
QUIT
+26 IF "^.01^.05^1.01^1.04^1.05^1.06^1.08^"[(U_+FLD_U)
Begin DoDot:1
+27 SET ROOT=$SELECT(+FLD=.01:"ICD9(",+FLD=.05:"AUTNPOV(",+FLD=1.01:"LEX(757.01,",(+FLD=1.04)!(+FLD=1.05):"VA(200,",+FLD=1.06:"DIC(49,",+FLD=1.08:"SC(",1:"")
if ROOT=""
QUIT
+28 SET ^TMP("ORXPND",$JOB,LCNT,0)=$JUSTIFY("from ",17)_$SELECT(OLD:$PIECE(@(U_ROOT_OLD_",0)"),U),1:"UNSPECIFIED")
+29 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=$JUSTIFY("to ",17)_$SELECT(NEW:$PIECE(@(U_ROOT_NEW_",0)"),U),1:"UNSPECIFIED")
End DoDot:1
+30 QUIT
