GMPLHIST.m

GMPLHIST ; SLC/MKB/KER -- Problem List Historical data ;06/08/12  13:37

 ;;2.0;Problem List;**7,26,31,35,36**;Aug 25, 1994;Build 65

 ;

 ; External References

 ;   DBIA 10060  ^VA(200

 ;

DT ; Add historical data (audit trail) to DT list

 ;   Called from ^GMPLDISP, requires AIFN and adds to GMPDT()

 N NODE,DATE,FLD,PROV,OLD,NEW,ROOT,CHNGE

 S NODE=$G(^GMPL(125.8,AIFN,0)) Q:NODE=""

 S DATE=$$EXTDT^GMPLX($P(NODE,U,3)),FLD=+$P(NODE,U,2),PROV=+$P(NODE,U,8)

 S:'PROV PROV=$P(NODE,U,4)

 S PROV=$S(PROV=".5":"NTRT",1:$P($G(^VA(200,PROV,0)),U))

 S FLD=FLD_U_$$FLDNAME(+FLD)

 S OLD=$P(NODE,U,5),NEW=$P(NODE,U,6),LCNT=LCNT+1

 I +FLD=1101 D  Q

 . N REASON

 . S REASON=" removed by "

 . S:OLD="C" REASON=" changed by "

 . S NODE=$G(^GMPL(125.8,AIFN,1))

 . S GMPDT(LCNT,0)=$J(DATE,10)_": NOTE "_$$EXTDT^GMPLX($P(NODE,U,5))_REASON_PROV_":"

 . S LCNT=LCNT+1,GMPDT(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 GMPDT(LCNT,0)=$J(DATE,10)_": PROBLEM "_CHNGE_" by "_PROV

 S GMPDT(LCNT,0)=$J(DATE,10)_": "_$P(FLD,U,2)_$S(OLD]"":" changed",1:" added")_" by "_PROV,LCNT=LCNT+1

 I +FLD=.12 S GMPDT(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 GMPDT(LCNT,0)=$J("from ",17)_$$EXTDT^GMPLX(OLD)_" to "_$$EXTDT^GMPLX(NEW) Q

 I +FLD=1.14 S GMPDT(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=80005 S GMPDT(LCNT,0)=$J("from ",17)_$S(OLD=1:"PENDING",OLD=2:"COMPLETED",1:"N/A")_" to "_$S(NEW=1:"PENDING",NEW="2":"COMPLETED",1:"N/A") Q

 I +FLD=302 D  Q

 . I NEW]"" D

 . . I OLD="" S GMPDT(LCNT,0)=$J(" as ",17)_NEW

 . . E  S GMPDT(LCNT,0)=$J("from ",17)_OLD_$$PAD^GMPLX(OLD,6)_" to "_NEW

 . E  S GMPDT(LCNT,0)=$J(OLD_$$PAD^GMPLX(OLD,6),23)_" removed."

 I +FLD>1.09 S GMPDT(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 GMPDT(LCNT,0)=$J("from ",17)_$S(OLD:$P(@(U_ROOT_OLD_",0)"),U)_$$PAD^GMPLX($P(@(U_ROOT_OLD_",0)"),U),6),1:"UNSPECIFIED")

 . S LCNT=LCNT+1,GMPDT(LCNT,0)=$J("to ",17)_$S(NEW:$P(@(U_ROOT_NEW_",0)"),U),1:"UNSPECIFIED")

 Q

 ;

FLDNAME(NUM) ; Returns Field Name for Display

 N NAME,NM1,NM2,I,J S J=0,NAME="" D NUM(.NM1),ALP(.NM2) S:+($G(NM1(+NUM)))=+NUM J=+NUM

 S:$L($G(NM2(+J))) NAME=$G(NM2(+J))

 Q NAME

ALP(X) ; Alpha Field Names

 S X(.01)="DIAGNOSIS",X(.02)="PATIENT NAME",X(.03)="DATE LAST MODIFIED",X(.04)="CLASS",X(.05)="PROVIDER NARRATIVE"

 S X(.06)="FACILITY",X(.07)="NUMBER",X(.08)="DATE ENTERED",X(.12)="STATUS",X(.13)="DATE OF ONSET",X(1.01)="PROBLEM",X(1.02)="CONDITION"

 S X(1.03)="ENTERED BY",X(1.04)="RECORDING PROVIDER",X(1.05)="RESPONSIBLE PROVIDER",X(1.06)="SERVICE",X(1.07)="DATE RESOLVED"

 S X(1.08)="CLINIC",X(1.09)="DATE RECORDED",X(1.1)="SERVICE CONNECTED",X(1.11)="AGENT ORANGE EXP",X(1.12)="RADIATION EXP",X(1.13)="ENV CONTAMINANTS EXP"

 S X(1.14)="IMMEDIACY",X(1.15)="HEAD/NECK CANCER",X(1.16)="MIL SEXUAL TRAUMA",X(1.17)="COMBAT VET",X(1.18)="SHAD",X(80001)="SNOMED CT CONCEPT",X(80002)="SNOMED CT DESIGNATION"

 S X(80003)="VHAT CONCEPT",X(80004)="VHAT DESIGNATION",X(80005)="MAP STATUS"

 S X(302)="SECONDARY DIAGNOSIS",X(1101)="NOTE"

 Q

NUM(X) ; Numeric Field Designations

 N FN F FN=.01:.01:.08 S X(+FN)=+FN

 F FN=.12:.01:.13 S X(+FN)=+FN

 F FN=1.01:.01:1.18 S X(+FN)=+FN

 F FN=80001:1:80005 S X(+FN)=+FN

 S X(1101)=1101,X(302)=302

 Q

GMPLHIST  ; SLC/MKB/KER -- Problem List Historical data ;06/08/12  13:37

 +1       ;;2.0;Problem List;**7,26,31,35,36**;Aug 25, 1994;Build 65

 +2       ;

 +3       ; External References

 +4       ;   DBIA 10060  ^VA(200

 +5       ;

DT        ; Add historical data (audit trail) to DT list

 +1       ;   Called from ^GMPLDISP, requires AIFN and adds to GMPDT()

 +2        NEW NODE,DATE,FLD,PROV,OLD,NEW,ROOT,CHNGE

 +3        SET NODE=$GET(^GMPL(125.8,AIFN,0))

           IF NODE=""

               QUIT 

 +4        SET DATE=$$EXTDT^GMPLX($PIECE(NODE,U,3))

           SET FLD=+$PIECE(NODE,U,2)

           SET PROV=+$PIECE(NODE,U,8)

 +5        IF 'PROV

               SET PROV=$PIECE(NODE,U,4)

 +6        SET PROV=$SELECT(PROV=".5":"NTRT",1:$PIECE($GET(^VA(200,PROV,0)),U))

 +7        SET FLD=FLD_U_$$FLDNAME(+FLD)

 +8        SET OLD=$PIECE(NODE,U,5)

           SET NEW=$PIECE(NODE,U,6)

           SET LCNT=LCNT+1

 +9        IF +FLD=1101

               Begin DoDot:1

 +10               NEW REASON

 +11               SET REASON=" removed by "

 +12               IF OLD="C"

                       SET REASON=" changed by "

 +13               SET NODE=$GET(^GMPL(125.8,AIFN,1))

 +14               SET GMPDT(LCNT,0)=$JUSTIFY(DATE,10)_": NOTE "_$$EXTDT^GMPLX($PIECE(NODE,U,5))_REASON_PROV_":"

 +15               SET LCNT=LCNT+1

                   SET GMPDT(LCNT,0)="            "_$PIECE(NODE,U,3)

               End DoDot:1

               QUIT 

 +16       IF +FLD=1.02

               Begin DoDot:1

 +17               SET CHNGE=$SELECT(NEW="H":"removed",OLD="T":"verified",1:"placed back on list")

 +18               SET GMPDT(LCNT,0)=$JUSTIFY(DATE,10)_": PROBLEM "_CHNGE_" by "_PROV

               End DoDot:1

               QUIT 

 +19       SET GMPDT(LCNT,0)=$JUSTIFY(DATE,10)_": "_$PIECE(FLD,U,2)_$SELECT(OLD]"":" changed",1:" added")_" by "_PROV

           SET LCNT=LCNT+1

 +20       IF +FLD=.12

               SET GMPDT(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 

 +21       IF (+FLD=.13)!(+FLD=1.07)

               SET GMPDT(LCNT,0)=$JUSTIFY("from ",17)_$$EXTDT^GMPLX(OLD)_" to "_$$EXTDT^GMPLX(NEW)

               QUIT 

 +22       IF +FLD=1.14

               SET GMPDT(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 

 +23       IF +FLD=80005

               SET GMPDT(LCNT,0)=$JUSTIFY("from ",17)_$SELECT(OLD=1:"PENDING",OLD=2:"COMPLETED",1:"N/A")_" to "_$SELECT(NEW=1:"PENDING",NEW="2":"COMPLETED",1:"N/A")

               QUIT 

 +24       IF +FLD=302

               Begin DoDot:1

 +25               IF NEW]""

                       Begin DoDot:2

 +26                       IF OLD=""

                               SET GMPDT(LCNT,0)=$JUSTIFY(" as ",17)_NEW

 +27                      IF '$TEST

                               SET GMPDT(LCNT,0)=$JUSTIFY("from ",17)_OLD_$$PAD^GMPLX(OLD,6)_" to "_NEW

                       End DoDot:2

 +28              IF '$TEST

                       SET GMPDT(LCNT,0)=$JUSTIFY(OLD_$$PAD^GMPLX(OLD,6),23)_" removed."

               End DoDot:1

               QUIT 

 +29       IF +FLD>1.09

               SET GMPDT(LCNT,0)=$JUSTIFY("from ",17)_$SELECT(+OLD:"YES",OLD=0:"NO",1:"UNKNOWN")_" to "_$SELECT(+NEW:"YES",NEW=0:"NO",1:"UNKNOWN")

               QUIT 

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

               Begin DoDot:1

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

 +32               SET GMPDT(LCNT,0)=$JUSTIFY("from ",17)_$SELECT(OLD:$PIECE(@(U_ROOT_OLD_",0)"),U)_$$PAD^GMPLX($PIECE(@(U_ROOT_OLD_",0)"),U),6),1:"UNSPECIFIED")

 +33               SET LCNT=LCNT+1

                   SET GMPDT(LCNT,0)=$JUSTIFY("to ",17)_$SELECT(NEW:$PIECE(@(U_ROOT_NEW_",0)"),U),1:"UNSPECIFIED")

               End DoDot:1

 +34       QUIT 

 +35      ;

FLDNAME(NUM) ; Returns Field Name for Display

 +1        NEW NAME,NM1,NM2,I,J

           SET J=0

           SET NAME=""

           DO NUM(.NM1)

           DO ALP(.NM2)

           IF +($GET(NM1(+NUM)))=+NUM

               SET J=+NUM

 +2        IF $LENGTH($GET(NM2(+J)))

               SET NAME=$GET(NM2(+J))

 +3        QUIT NAME

ALP(X)    ; Alpha Field Names

 +1        SET X(.01)="DIAGNOSIS"

           SET X(.02)="PATIENT NAME"

           SET X(.03)="DATE LAST MODIFIED"

           SET X(.04)="CLASS"

           SET X(.05)="PROVIDER NARRATIVE"

 +2        SET X(.06)="FACILITY"

           SET X(.07)="NUMBER"

           SET X(.08)="DATE ENTERED"

           SET X(.12)="STATUS"

           SET X(.13)="DATE OF ONSET"

           SET X(1.01)="PROBLEM"

           SET X(1.02)="CONDITION"

 +3        SET X(1.03)="ENTERED BY"

           SET X(1.04)="RECORDING PROVIDER"

           SET X(1.05)="RESPONSIBLE PROVIDER"

           SET X(1.06)="SERVICE"

           SET X(1.07)="DATE RESOLVED"

 +4        SET X(1.08)="CLINIC"

           SET X(1.09)="DATE RECORDED"

           SET X(1.1)="SERVICE CONNECTED"

           SET X(1.11)="AGENT ORANGE EXP"

           SET X(1.12)="RADIATION EXP"

           SET X(1.13)="ENV CONTAMINANTS EXP"

 +5        SET X(1.14)="IMMEDIACY"

           SET X(1.15)="HEAD/NECK CANCER"

           SET X(1.16)="MIL SEXUAL TRAUMA"

           SET X(1.17)="COMBAT VET"

           SET X(1.18)="SHAD"

           SET X(80001)="SNOMED CT CONCEPT"

           SET X(80002)="SNOMED CT DESIGNATION"

 +6        SET X(80003)="VHAT CONCEPT"

           SET X(80004)="VHAT DESIGNATION"

           SET X(80005)="MAP STATUS"

 +7        SET X(302)="SECONDARY DIAGNOSIS"

           SET X(1101)="NOTE"

 +8        QUIT 

NUM(X)    ; Numeric Field Designations

 +1        NEW FN

           FOR FN=.01:.01:.08

               SET X(+FN)=+FN

 +2        FOR FN=.12:.01:.13

               SET X(+FN)=+FN

 +3        FOR FN=1.01:.01:1.18

               SET X(+FN)=+FN

 +4        FOR FN=80001:1:80005

               SET X(+FN)=+FN

 +5        SET X(1101)=1101

           SET X(302)=302

 +6        QUIT