- GMPLHIST ; SLC/MKB/KER/TC -- Problem List Historical data ;02/26/15 09:09
- ;;2.0;Problem List;**7,26,31,35,36,42,46,45**;Aug 25, 1994;Build 53
- ;
- ; 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,OLDVAL,NEW,NEWVAL,ROOT,CHNGE,GMPLCSYS,PREVAUTH
- 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 PREVAUTH=$P(NODE,U,6)
- . S GMPDT(LCNT,0)=$J(DATE,10)_": Previous NOTE "_$$EXTDT^GMPLX($P(NODE,U,5))_" from "_$P($G(^VA(200,+PREVAUTH,0)),U)_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=.01 D Q
- . N CSYSOLD,CSYSNEW
- . S CSYSOLD=$$CSI^ICDEX(80,OLD),CSYSNEW=$$CSI^ICDEX(80,NEW)
- . S GMPDT(LCNT,0)=$J("from ",17)_$S(CSYSOLD=30:"(ICD-10-CM ",1:"(ICD-9-CM ")_$P($$ICDDATA^ICDXCODE(CSYSOLD,OLD,DT,"I"),U,2)_")"_" to "_$S(CSYSNEW=30:"(ICD-10-CM ",1:"(ICD-9-CM ")_$P($$ICDDATA^ICDXCODE(CSYSNEW,NEW,DT,"I"),U,2)_")"
- 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)&(+FLD<=1.18) 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 (+FLD=80001)!(+FLD=80002) S GMPDT(LCNT,0)=$J("from ",17)_OLD_" to "_NEW
- I "^.05^1.01^1.04^1.05^1.06^1.08^"[(U_+FLD_U) D
- . S ROOT=$S(+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 OLDVAL=$S(OLD="":"",1:$P($G(@(U_ROOT_OLD_",0)")),U))
- . S NEWVAL=$S(NEW="":"",1:$P($G(@(U_ROOT_NEW_",0)")),U))
- . S GMPDT(LCNT,0)=$J("from ",17)_$S(OLDVAL'="":OLDVAL_$$PAD^GMPLX(OLDVAL,6),1:"UNSPECIFIED")
- . S LCNT=LCNT+1,GMPDT(LCNT,0)=$J("to ",17)_$S(NEWVAL'="":NEWVAL,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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLHIST 4395 printed Feb 18, 2025@23:56:33 Page 2
- GMPLHIST ; SLC/MKB/KER/TC -- Problem List Historical data ;02/26/15 09:09
- +1 ;;2.0;Problem List;**7,26,31,35,36,42,46,45**;Aug 25, 1994;Build 53
- +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,OLDVAL,NEW,NEWVAL,ROOT,CHNGE,GMPLCSYS,PREVAUTH
- +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 PREVAUTH=$PIECE(NODE,U,6)
- +15 SET GMPDT(LCNT,0)=$JUSTIFY(DATE,10)_": Previous NOTE "_$$EXTDT^GMPLX($PIECE(NODE,U,5))_" from "_$PIECE($GET(^VA(200,+PREVAUTH,0)),U)_REASON_PROV_":"
- +16 SET LCNT=LCNT+1
- SET GMPDT(LCNT,0)=" "_$PIECE(NODE,U,3)
- End DoDot:1
- QUIT
- +17 IF +FLD=1.02
- Begin DoDot:1
- +18 SET CHNGE=$SELECT(NEW="H":"removed",OLD="T":"verified",1:"placed back on list")
- +19 SET GMPDT(LCNT,0)=$JUSTIFY(DATE,10)_": PROBLEM "_CHNGE_" by "_PROV
- End DoDot:1
- QUIT
- +20 SET GMPDT(LCNT,0)=$JUSTIFY(DATE,10)_": "_$PIECE(FLD,U,2)_$SELECT(OLD]"":" changed",1:" added")_" by "_PROV
- SET LCNT=LCNT+1
- +21 IF +FLD=.01
- Begin DoDot:1
- +22 NEW CSYSOLD,CSYSNEW
- +23 SET CSYSOLD=$$CSI^ICDEX(80,OLD)
- SET CSYSNEW=$$CSI^ICDEX(80,NEW)
- +24 SET GMPDT(LCNT,0)=$JUSTIFY("from ",17)_$SELECT(CSYSOLD=30:"(ICD-10-CM ",1:"(ICD-9-CM ")_$PIECE($$ICDDATA^ICDXCODE(CSYSOLD,OLD,DT,"I"),U,2)_")"_" to "_$SELECT(CSYSNEW=30:"(ICD-10-CM ",1:"(ICD-9-CM ")_$PIECE($$ICDDATA^ICDXCODE(CSYSNEW,NEW
- ,DT,"I"),U,2)_")"
- End DoDot:1
- QUIT
- +25 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
- +26 IF (+FLD=.13)!(+FLD=1.07)
- SET GMPDT(LCNT,0)=$JUSTIFY("from ",17)_$$EXTDT^GMPLX(OLD)_" to "_$$EXTDT^GMPLX(NEW)
- QUIT
- +27 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
- +28 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
- +29 IF +FLD=302
- Begin DoDot:1
- +30 IF NEW]""
- Begin DoDot:2
- +31 IF OLD=""
- SET GMPDT(LCNT,0)=$JUSTIFY(" as ",17)_NEW
- +32 IF '$TEST
- SET GMPDT(LCNT,0)=$JUSTIFY("from ",17)_OLD_$$PAD^GMPLX(OLD,6)_" to "_NEW
- End DoDot:2
- +33 IF '$TEST
- SET GMPDT(LCNT,0)=$JUSTIFY(OLD_$$PAD^GMPLX(OLD,6),23)_" removed."
- End DoDot:1
- QUIT
- +34 IF (+FLD>1.09)&(+FLD<=1.18)
- 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
- +35 IF (+FLD=80001)!(+FLD=80002)
- SET GMPDT(LCNT,0)=$JUSTIFY("from ",17)_OLD_" to "_NEW
- +36 IF "^.05^1.01^1.04^1.05^1.06^1.08^"[(U_+FLD_U)
- Begin DoDot:1
- +37 SET ROOT=$SELECT(+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
- +38 SET OLDVAL=$SELECT(OLD="":"",1:$PIECE($GET(@(U_ROOT_OLD_",0)")),U))
- +39 SET NEWVAL=$SELECT(NEW="":"",1:$PIECE($GET(@(U_ROOT_NEW_",0)")),U))
- +40 SET GMPDT(LCNT,0)=$JUSTIFY("from ",17)_$SELECT(OLDVAL'="":OLDVAL_$$PAD^GMPLX(OLDVAL,6),1:"UNSPECIFIED")
- +41 SET LCNT=LCNT+1
- SET GMPDT(LCNT,0)=$JUSTIFY("to ",17)_$SELECT(NEWVAL'="":NEWVAL,1:"UNSPECIFIED")
- End DoDot:1
- +42 QUIT
- +43 ;
- 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