Changeset 623 for WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLHIST.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLHIST.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLHIST.m
r613 r623 1 GMPLHIST 2 ;;2.0;Problem List;**7,26,,31,35**;Aug 25, 1994;Build 26 3 4 5 6 7 DT 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 FLDNAME(NUM) 36 37 38 39 ALP(X) 40 41 42 43 44 S X(1.14)="PRIORITY",X(1.15)="HEAD/NECK CANCER",X(1.16)="MIL SEXUAL TRAUMA",X(1.17)="COMBAT VET",X(1.18)="SHAD",X(1101)="NOTE"45 46 NUM(X) 47 48 49 F FN=1.01:.01:1.18S X(+FN)=+FN50 51 1 GMPLHIST ; SLC/MKB/KER -- Problem List Historical data ; 04/15/2002 2 ;;2.0;Problem List;**7,26,31**;Aug 25, 1994;Build 1 3 ; 4 ; External References 5 ; DBIA 10060 ^VA(200 6 ; 7 DT ; Add historical data (audit trail) to DT list 8 ; Called from ^GMPLDISP, requires AIFN and adds to GMPDT() 9 N NODE,DATE,FLD,PROV,OLD,NEW,ROOT,CHNGE,REASON 10 S NODE=$G(^GMPL(125.8,AIFN,0)) Q:NODE="" 11 S DATE=$$EXTDT^GMPLX($P(NODE,U,3)),FLD=+$P(NODE,U,2),PROV=+$P(NODE,U,8) 12 S:'PROV PROV=$P(NODE,U,4) 13 S FLD=FLD_U_$$FLDNAME(+FLD),PROV=$P($G(^VA(200,PROV,0)),U) 14 S OLD=$P(NODE,U,5),NEW=$P(NODE,U,6),LCNT=LCNT+1 15 I +FLD=1101 D Q 16 . S REASON=" removed by " 17 . S:OLD="C" REASON=" changed by " 18 . S NODE=$G(^GMPL(125.8,AIFN,1)) 19 . S GMPDT(LCNT,0)=$J(DATE,10)_": NOTE "_$$EXTDT^GMPLX($P(NODE,U,5))_REASON_PROV_":" 20 . S LCNT=LCNT+1,GMPDT(LCNT,0)=" "_$P(NODE,U,3) 21 I +FLD=1.02 D Q 22 . S CHNGE=$S(NEW="H":"removed",OLD="T":"verified",1:"placed back on list") 23 . S GMPDT(LCNT,0)=$J(DATE,10)_": PROBLEM "_CHNGE_" by "_PROV 24 S GMPDT(LCNT,0)=$J(DATE,10)_": "_$P(FLD,U,2)_" changed by "_PROV,LCNT=LCNT+1 25 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 26 I (+FLD=.13)!(+FLD=1.07) S GMPDT(LCNT,0)=$J("from ",17)_$$EXTDT^GMPLX(OLD)_" to "_$$EXTDT^GMPLX(NEW) Q 27 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 28 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 29 I "^.01^.05^1.01^1.04^1.05^1.06^1.08^"[(U_+FLD_U) D 30 . 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="" 31 . S GMPDT(LCNT,0)=$J("from ",17)_$S(OLD:$P(@(U_ROOT_OLD_",0)"),U),1:"UNSPECIFIED") 32 . S LCNT=LCNT+1,GMPDT(LCNT,0)=$J("to ",17)_$S(NEW:$P(@(U_ROOT_NEW_",0)"),U),1:"UNSPECIFIED") 33 Q 34 ; 35 FLDNAME(NUM) ; Returns Field Name for Display 36 N NAME,NM1,NM2,I,J S J=0,NAME="" D NUM(.NM1),ALP(.NM2) S:+($G(NM1(+NUM)))=+NUM J=+NUM 37 S:$L($G(NM2(+J))) NAME=$G(NM2(+J)) 38 Q NAME 39 ALP(X) ; Alpha Field Names 40 S X(.01)="DIAGNOSIS",X(.02)="PATIENT NAME",X(.03)="DATE LAST MODIFIED",X(.04)="CLASS",X(.05)="PROVIDER NARRATIVE" 41 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" 42 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" 43 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" 44 S X(1.14)="PRIORITY",X(1.15)="HEAD/NECK CANCER",X(1.16)="MIL SEXUAL TRAUMA",X(1101)="NOTE" 45 Q 46 NUM(X) ; Numeric Field Designations 47 N FN F FN=.01:.01:.08 S X(+FN)=+FN 48 F FN=.12:.01:.13 S X(+FN)=+FN 49 F FN=1.01:.01:1.16 S X(+FN)=+FN 50 S X(1101)=1101 51 Q
Note:
See TracChangeset
for help on using the changeset viewer.
