- 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 Feb 18, 2025@23:55:44 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
