ORCXPND4.m

ORCXPND4 ; SLC/MKB,MA - Expanded Display cont ;9/10/99  13:16

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**67**;Dec 17, 1997

 ;

PL ; -- problem list

 N ORPL,X,I,CNT,PROBLEM,II

 D DETAIL^GMPLUTL2(+ID,.ORPL)

 S PROBLEM=(LCNT+1)_U_ORPL("NARRATIVE")_" ("_ORPL("DIAGNOSIS")_")" ; #^Text

 S X(1)=$P(PROBLEM,U,2),X(2)="          "

 S X(3)="   Onset: "_ORPL("ONSET"),X(3)=X(3)_$J("SC Condition: ",61-$L(X(3)))_ORPL("SC")

 S X(4)="  Status: "_ORPL("STATUS")_$S($L(ORPL("PRIORITY")):"/"_ORPL("PRIORITY"),1:""),X(4)=X(4)_$J("Exposure: ",61-$L(X(4)))_$S('ORPL("EXPOSURE"):"NONE",1:ORPL("EXPOSURE",1))

 S X(5)="Provider: "_ORPL("PROVIDER")

 S:ORPL("EXPOSURE")>1 X(5)=X(5)_$$REPEAT^XLFSTR(" ",61-$L(X(5)))_ORPL("EXPOSURE",2)

 S X(6)="  Clinic: "_ORPL("CLINIC")

 S:ORPL("EXPOSURE")>2 X(6)=X(6)_$$REPEAT^XLFSTR(" ",61-$L(X(6)))_ORPL("EXPOSURE",3)

PL1 S X(7)="          "

 S X(8)="Recorded: "_$P(ORPL("RECORDED"),U)_", by "_$P(ORPL("RECORDED"),U,2)

 S X(9)=" Entered: "_$P(ORPL("ENTERED"),U)_", by "_$P(ORPL("ENTERED"),U,2)

 S X(10)=" Updated: "_ORPL("MODIFIED")

 S X(11)="          ",X(12)="Comments: ",CNT=12

 S:ORPL("COMMENT")'>0 X(13)="   <None>",CNT=13

 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(12,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>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

ORCXPND4  ; SLC/MKB,MA - Expanded Display cont ;9/10/99  13:16

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**67**;Dec 17, 1997

 +2       ;

PL        ; -- problem list

 +1        NEW ORPL,X,I,CNT,PROBLEM,II

 +2        DO DETAIL^GMPLUTL2(+ID,.ORPL)

 +3       ; #^Text

           SET PROBLEM=(LCNT+1)_U_ORPL("NARRATIVE")_" ("_ORPL("DIAGNOSIS")_")"

 +4        SET X(1)=$PIECE(PROBLEM,U,2)

           SET X(2)="          "

 +5        SET X(3)="   Onset: "_ORPL("ONSET")

           SET X(3)=X(3)_$JUSTIFY("SC Condition: ",61-$LENGTH(X(3)))_ORPL("SC")

 +6        SET X(4)="  Status: "_ORPL("STATUS")_$SELECT($LENGTH(ORPL("PRIORITY")):"/"_ORPL("PRIORITY"),1:"")

           SET X(4)=X(4)_$JUSTIFY("Exposure: ",61-$LENGTH(X(4)))_$SELECT('ORPL("EXPOSURE"):"NONE",1:ORPL("EXPOSURE",1))

 +7        SET X(5)="Provider: "_ORPL("PROVIDER")

 +8        IF ORPL("EXPOSURE")>1

               SET X(5)=X(5)_$$REPEAT^XLFSTR(" ",61-$LENGTH(X(5)))_ORPL("EXPOSURE",2)

 +9        SET X(6)="  Clinic: "_ORPL("CLINIC")

 +10       IF ORPL("EXPOSURE")>2

               SET X(6)=X(6)_$$REPEAT^XLFSTR(" ",61-$LENGTH(X(6)))_ORPL("EXPOSURE",3)

PL1        SET X(7)="          "

 +1        SET X(8)="Recorded: "_$PIECE(ORPL("RECORDED"),U)_", by "_$PIECE(ORPL("RECORDED"),U,2)

 +2        SET X(9)=" Entered: "_$PIECE(ORPL("ENTERED"),U)_", by "_$PIECE(ORPL("ENTERED"),U,2)

 +3        SET X(10)=" Updated: "_ORPL("MODIFIED")

 +4        SET X(11)="          "

           SET X(12)="Comments: "

           SET CNT=12

 +5        IF ORPL("COMMENT")'>0

               SET X(13)="   <None>"

               SET CNT=13

 +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(12,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>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 

 +19       IF "^.01^.05^1.01^1.04^1.05^1.06^1.08^"[(U_+FLD_U)

               Begin DoDot:1

 +20               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 

 +21               SET ^TMP("ORXPND",$JOB,LCNT,0)=$JUSTIFY("from ",17)_$SELECT(OLD:$PIECE(@(U_ROOT_OLD_",0)"),U),1:"UNSPECIFIED")

 +22               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

 +23       QUIT