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
