Changeset 623 for WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLUTL2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLUTL2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLUTL2.m
r613 r623 1 GMPLUTL2 ; SLC/MKB/KER -- PL Utilities (OE/TIU) ; 04/15/2002 2 ;;2.0;Problem List;**10,18,21,26,35**;Aug 25, 1994;Build 26 3 ; External References 4 ; DBIA 348 ^DPT( file #2 5 ; DBIA 10082 ^ICD9( file #80 6 ; DBIA 10040 ^SC( file #44 7 ; DBIA 10060 ^VA(200 8 ; DBIA 2716 $$GETSTAT^DGMSTAPI 9 ; DBIA 3457 $$GETCUR^DGNTAPI 10 ; DBIA 10062 7^VADPT 11 ; DBIA 10062 DEM^VADPT 12 ; DBIA 10118 EN^VALM 13 ; DBIA 10116 CLEAR^VALM1 14 ; DBIA 10103 $$HTFM^XLFDT 15 LIST(GMPL,GMPDFN,GMPSTAT,GMPCOMM) ; Returns list of Prob for Pt. 16 ; Input GMPDFN Pointer to Patient file #2 17 ; GMPCOMP Display Comments 1/0 18 ; GMTSTAT Status A/I/"" 19 ; Output GMPL Array, passed by reference 20 ; GMPL(#) 21 ; Piece 1: Pointer to Problem #9000011 22 ; 2: Status 23 ; 3: Description 24 ; 4: ICD-9 code 25 ; 5: Date of Onset 26 ; 6: Date Last Modified 27 ; 7: Service Connected 28 ; 8: Special Exposures 29 ; GMPL(#,C#) Comments 30 ; GMPL(0) Number of Problems Returned 31 N I,IFN,CNT,GMPL0,GMPL1,SP,ST,NUM,ONSET,ICD,LASTMOD,SC,GMPLIST,GMPLVIEW,GMPARAM,GMPTOTAL 32 Q:$G(GMPDFN)'>0 S CNT=0,SP="" 33 S GMPARAM("QUIET")=1,GMPARAM("REV")=$P($G(^GMPL(125.99,1,0)),U,5)="R" 34 S GMPLVIEW("ACT")=GMPSTAT,GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")="" 35 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW) 36 F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D 37 . S IFN=+GMPLIST(NUM) Q:IFN'>0 38 . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)),CNT=CNT+1 39 . S ICD=$P($G(^ICD9(+GMPL0,0)),U),LASTMOD=$P(GMPL0,U,3) 40 . S ST=$P(GMPL0,U,12),ONSET=$P(GMPL0,U,13) 41 . S SC=$S(+$P(GMPL1,U,10):"SC",$P(GMPL1,U,10)=0:"NSC",1:"") 42 . N SCS D SCS^GMPLX1(IFN,.SCS) S SP=$G(SCS(3)) 43 . S GMPL(CNT)=IFN_U_ST_U_$$PROBTEXT^GMPLX(IFN)_U_ICD_U_ONSET_U_LASTMOD_U_SC_U_SP_U_$S($P(GMPL1,U,14)="A":"*",1:"")_U_$S('$P($G(^GMPL(125.99,1,0)),U,2):"",$P(GMPL1,U,2)'="T":"",1:"$") 44 . I $G(GMPCOMM) D 45 . . N FAC,NIFN,NOTE,NOTECNT 46 . . S NOTECNT=0,FAC=0 47 . . F S FAC=$O(^AUPNPROB(IFN,11,FAC)) Q:+FAC'>0 D 48 . . . S NIFN=0 49 . . . F S NIFN=$O(^AUPNPROB(IFN,11,FAC,11,NIFN)) Q:NIFN'>0 D 50 . . . . S NOTE=$P($G(^AUPNPROB(IFN,11,FAC,11,NIFN,0)),U,3) 51 . . . . S NOTECNT=NOTECNT+1,GMPL(CNT,NOTECNT)=NOTE 52 S GMPL(0)=CNT 53 Q 54 ; 55 DETAIL(IFN,GMPL) ; Returns Detailed Data for Problem 56 ; 57 ; Input IFN Pointer to Problem file #9000011 58 ; 59 ; Output GMPL Array, passed by reference 60 ; GMPL("DATA NAME") = External Format of Value 61 ; 62 ; GMPL("DIAGNOSIS") ICD Code 63 ; GMPL("PATIENT") Patient Name 64 ; GMPL("MODIFIED") Date Last Modified 65 ; GMPL("NARRATIVE") Provider Narrative 66 ; GMPL("ENTERED") Date Entered ^ Entered by 67 ; GMPL("STATUS") Status 68 ; GMPL("PRIORITY") Priority Acute/Chronic 69 ; GMPL("ONSET") Date of Onset 70 ; GMPL("PROVIDER") Responsible Provider 71 ; GMPL("RECORDED") Date Recorded ^ Recorded by 72 ; GMPL("CLINIC") Hospital Location 73 ; GMPL("SC") Service Connected SC/NSC/"" 74 ; 75 ; GMPL("EXPOSURE") = # 76 ; GMPL("EXPOSURE",X)="AGENT ORANGE" 77 ; GMPL("EXPOSURE",X)="RADIATION" 78 ; GMPL("EXPOSURE",X)="ENV CONTAMINANTS" 79 ; GMPL("EXPOSURE",X)="HEAD AND/OR NECK CANCER" 80 ; GMPL("EXPOSURE",X)="MILITARY SEXUAL TRAUMA" 81 ; GMPL("EXPOSURE",X)="COMBAT VET" 82 ; GMPL("EXPOSURE",X)="SHAD" 83 ; 84 ; GMPL("COMMENT") = # 85 ; GMPL("COMMENT",CNT) = Date ^ Author ^ Text of Note 86 ; 87 N GMPL0,GMPL1,GMPLP,X,I,FAC,CNT,NIFN Q:'$D(^AUPNPROB(IFN,0)) 88 S GMPLP=+($$PTR^GMPLUTL4),GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)) 89 S GMPL("DIAGNOSIS")=$P($G(^ICD9(+GMPL0,0)),U) 90 S GMPL("PATIENT")=$P($G(^DPT(+$P(GMPL0,U,2),0)),U) 91 S GMPL("MODIFIED")=$$EXTDT^GMPLX($P(GMPL0,U,3)) 92 S GMPL("NARRATIVE")=$$PROBTEXT^GMPLX(IFN) 93 S GMPL("ENTERED")=$$EXTDT^GMPLX($P(GMPL0,U,8))_U_$P($G(^VA(200,+$P(GMPL1,U,3),0)),U) 94 S X=$P(GMPL0,U,12),GMPL("STATUS")=$S(X="A":"ACTIVE",1:"INACTIVE") 95 S X=$S(X'="A":"",1:$P(GMPL1,U,14)),GMPL("PRIORITY")=$S(X="A":"ACUTE",X="C":"CHRONIC",1:"") 96 S GMPL("ONSET")=$$EXTDT^GMPLX($P(GMPL0,U,13)) 97 S GMPL("PROVIDER")=$P($G(^VA(200,+$P(GMPL1,U,5),0)),U) 98 S GMPL("RECORDED")=$$EXTDT^GMPLX($P(GMPL1,U,9))_U_$P($G(^VA(200,+$P(GMPL1,U,4),0)),U) 99 S GMPL("CLINIC")=$P($G(^SC(+$P(GMPL1,U,8),0)),U) 100 S GMPL("SC")=$S($P(GMPL1,U,10):"YES",$P(GMPL1,U,10)=0:"NO",1:"UNKNOWN") 101 S GMPL("EXPOSURE")=0 102 I $P(GMPL1,U,11) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="AGENT ORANGE",GMPL("EXPOSURE")=X 103 I $P(GMPL1,U,12) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="RADIATION",GMPL("EXPOSURE")=X 104 I $P(GMPL1,U,13) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="ENV CONTAMINANTS",GMPL("EXPOSURE")=X 105 I $P(GMPL1,U,15) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="HEAD AND/OR NECK CANCER",GMPL("EXPOSURE")=X 106 I $P(GMPL1,U,16) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="MILITARY SEXUAL TRAUMA",GMPL("EXPOSURE")=X 107 I $P(GMPL1,U,17) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="COMBAT VET",GMPL("EXPOSURE")=X 108 I $P(GMPL1,U,18)&(GMPLP'>0) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="SHAD",GMPL("EXPOSURE")=X 109 S (FAC,CNT)=0,GMPL("COMMENT")=0 110 F FAC=0:0 S FAC=$O(^AUPNPROB(IFN,11,FAC)) Q:+FAC'>0 D 111 . F NIFN=0:0 S NIFN=$O(^AUPNPROB(IFN,11,FAC,11,NIFN)) Q:NIFN'>0 D 112 . . S X=$G(^AUPNPROB(IFN,11,FAC,11,NIFN,0)) 113 . . S CNT=CNT+1,GMPL("COMMENT",CNT)=$$EXTDT^GMPLX($P(X,U,5))_U_$P($G(^VA(200,+$P(X,U,6),0)),U)_U_$P(X,U,3) 114 S GMPL("COMMENT")=CNT D AUDIT 115 Q 116 ; 117 AUDIT ; 14 Sep 99 - MA - Add audit trail to OE Problem List. 118 ; Called from DETAIL, requires IFN and sets GMPL("AUDIT") 119 N IDT,AIFN,X0,X1,FLD,CNT 120 S CNT=0,GMPL("AUDIT")=CNT 121 F IDT=0:0 S IDT=$O(^GMPL(125.8,"AD",IFN,IDT)) Q:IDT'>0 D 122 . F AIFN=0:0 S AIFN=$O(^GMPL(125.8,"AD",IFN,IDT,AIFN)) Q:AIFN'>0 D 123 .. S X0=$G(^GMPL(125.8,AIFN,0)),X1=$G(^(1)) Q:'$L(X0) 124 .. S FLD=$$FLDNAME(+$P(X0,U,2)) 125 .. S CNT=CNT+1 126 .. S GMPL("AUDIT",CNT,0)=$P(X0,U,2)_U_FLD_U_$P(X0,U,3,8) 127 .. ; = pointer#^fld name^date mod^who mod^old^new^reason^prov 128 .. S:$L(X1) GMPL("AUDIT",CNT,1)=X1 129 S GMPL("AUDIT")=CNT 130 Q 131 ; 132 FLDNAME(NUM) ; Returns field name for display 133 N NAME,NM1,NM2,I,J S J=0,NAME="" 134 S NM1=".01^.05^.12^.13^1.01^1.02^1.04^1.05^1.06^1.07^1.08^1.09^1.1^1.11^1.12^1.13^1.14^1.17^1.18^1101" 135 F I=1:1:$L(NM1,U) I +$P(NM1,U,I)=+NUM S J=I Q 136 G:J'>0 FNQ 137 S NM2="DIAGNOSIS^PROVIDER NARRATIVE^STATUS^DATE OF ONSET^PROBLEM^CONDITION^RECORDING PROVIDER^RESPONSIBLE PROVIDER" 138 S NM2=NM2_"^SERVICE^DATE RESOLVED^CLINIC^DATE RECORDED^SERVICE CONNECTED^AGENT ORANGE EXP^RADIATION EXP^ENV CONTAMINANTS EXP" 139 S NM2=NM2_"^COMBAT VET^SHIPBOARD HAZARD EXP^PRIORITY^NOTE" 140 S NAME=$P(NM2,U,J) 141 FNQ Q NAME 142 ; 143 ADD(DFN,LOC,GMPROV) ; -- Interactive LMgr action to add new problem 144 N X,Y,GMPDFN,GMPVA,GMPVAMC,GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPHNC,GMPMST,GMPCV,GMPSHD 145 N GMPARAM,GMPLVIEW,GMPLUSER,GMPCLIN,GMPLSLST,GMPQUIT,VALMCC,GMPSAVED 146 Q:'DFN Q:'LOC D SETVARS 147 S GMPLSLST=$P($G(^VA(200,DUZ,125)),U,2),VALMCC=0 148 I 'GMPLSLST,GMPCLIN,$D(^GMPL(125,"C",+GMPCLIN)) S GMPLSLST=$O(^(+GMPCLIN,0)) 149 I GMPLSLST D Q 150 . S $P(GMPLSLST,U,2)=$P($G(^GMPL(125,+GMPLSLST,0)),U) 151 . D EN^VALM("GMPL LIST MENU") 152 F D ADD^GMPL1 Q:$D(GMPQUIT) K DUOUT,DTOUT,GMPSAVED W !!,">>> Please enter another problem, or press <return> to exit." 153 Q 154 ; 155 SETVARS ; -- Define GMP* variables used in ADD and EDIT 156 N VA,VADM,VAEL,VASV,X 157 Q:'DFN D DEM^VADPT,7^VADPT 158 S GMPDFN=DFN_U_VADM(1)_U_$E(VADM(1))_VA("BID")_$S(VADM(6):U_+VADM(6),1:"") 159 S AUPNSEX=$P(VADM(5),U),GMPVA=1,GMPSC=VAEL(3),GMPAGTOR=VASV(2),GMPION=VASV(3) 160 S X=$P($G(^DPT(DFN,.322)),U,10),GMPGULF=$S(X="Y":1,X="N":0,1:"") 161 S GMPCV=0 I +$G(VASV(10)) S:DT'>$P($G(VASV(10,1)),U) GMPCV=1 ;CV 162 S GMPSHD=+$G(VASV(14,1)) ;SHAD 163 S X=$$GETCUR^DGNTAPI(DFN,"HNC"),X=+($G(HNC("STAT"))),GMPHNC=$S(X=4:1,X=5:1,X=1:0,X=6:0,1:"") 164 S X=$P($$GETSTAT^DGMSTAPI(DFN),"^",2),GMPMST=$S(X="Y":1,X="N":0,1:"") 165 S GMPLVIEW("VIEW")=$S($P($G(^SC(+$G(LOC),0)),U,3)="C":"C",1:"S") 166 S GMPCLIN="" I $G(LOC),GMPLVIEW("VIEW")="C" S GMPCLIN=+LOC_U_$P(^SC(+LOC,0),U) 167 S X=$$PARAM,GMPARAM("VER")=+$P(X,U,2),GMPARAM("CLU")=+$P(X,U,4),GMPARAM("REV")=+$P(X,U,5) 168 S:+GMPROV=DUZ GMPLUSER=1 S GMPVAMC=+$G(DUZ(2)),GMPLIST(0)=0 169 Q 170 ; 171 EDIT(DFN,LOC,GMPROV,GMPIFN) ; Interactive LMgr action to edit a problem 172 N GMPARAM,GMPDFN,GMPVA,GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPHNC,GMPMST,GMPCV,GMPSHD 173 N GMPLVIEW,GMPCLIN,GMPLJUMP,GMPQUIT,GMPLUSER,GMPLVAMC,AUPNSEX 174 L +^AUPNPROB(GMPIFN,0):1 I '$T W $C(7),!!,$$LOCKED^GMPLX,! H 2 Q 175 D SETVARS,EN^VALM("GMPL EDIT PROBLEM") 176 L -^AUPNPROB(GMPIFN,0) 177 Q 178 ; 179 REMOVE(GMPIFN,GMPROV,TEXT,PLY) ; -- Remove problem GMPIFN 180 N GMPVAMC,CHANGE 181 S GMPVAMC=+$G(DUZ(2)),PLY=-1,PLY(0)="" 182 I '$L($G(^AUPNPROB(GMPIFN,0))) S PLY(0)="Invalid problem" Q 183 I '$D(^VA(200,+$G(GMPROV),0)) S PLY(0)="Invalid provider" Q 184 I $L($G(TEXT)) S GMPFLD(10,"NEW",1)=TEXT D NEWNOTE^GMPLSAVE 185 S CHANGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($H)_U_DUZ_U_$P($G(^AUPNPROB(GMPIFN,1)),U,2)_"^H^Deleted^"_+$G(GMPROV),$P(^AUPNPROB(GMPIFN,1),U,2)="H",PLY=GMPIFN 186 D AUDIT^GMPLX(CHANGE,""),DTMOD^GMPLX(GMPIFN) 187 Q 188 ; 189 PARAM() ; -- Returns parameter values from 125.99 190 Q $G(^GMPL(125.99,1,0)) 191 ; 192 VAF(DFN,SILENT) ; -- print PL VA Form chart copy 193 ; 194 N VA,VADM,VAERR,GMPDFN,GMPVAMC,X,GMPARAM,GMPRT,GMPQUIT,GMPLCURR 195 Q:'$G(DFN) D DEM^VADPT S GMPDFN=DFN_U_VADM(1)_U_$E(VADM(1))_VA("BID") 196 S GMPVAMC=+$G(DUZ(2)),GMPARAM("QUIET")=1 197 S X=$G(^GMPL(125.99,1,0)),GMPARAM("VER")=+$P(X,U,2),GMPARAM("PRT")=+$P(X,U,3),GMPARAM("CLU")=+$P(X,U,4),GMPARAM("REV")=$S($P(X,U,5)="R":1,1:0) K X 198 D VAF^GMPLPRNT I '$G(SILENT) D Q:$G(GMPQUIT) 199 . I GMPRT'>0 W !!,"No problems available." S GMPQUIT=1 Q 200 . D DEVICE^GMPLPRNT Q:$G(GMPQUIT) D CLEAR^VALM1 201 D PRT^GMPLPRNT 202 Q 1 GMPLUTL2 ; SLC/MKB/KER -- PL Utilities (OE/TIU) ; 04/15/2002 2 ;;2.0;Problem List;**10,18,21,26**;Aug 25, 1994 3 ; 4 ; External References 5 ; DBIA 348 ^DPT( file #2 6 ; DBIA 10082 ^ICD9( file #80 7 ; DBIA 10040 ^SC( file #44 8 ; DBIA 10060 ^VA(200 9 ; DBIA 2716 $$GETSTAT^DGMSTAPI 10 ; DBIA 3457 $$GETCUR^DGNTAPI 11 ; DBIA 10062 7^VADPT 12 ; DBIA 10062 DEM^VADPT 13 ; DBIA 10118 EN^VALM 14 ; DBIA 10116 CLEAR^VALM1 15 ; DBIA 10103 $$HTFM^XLFDT 16 ; 17 LIST(GMPL,GMPDFN,GMPSTAT,GMPCOMM) ; Returns list of Problems for Patient 18 ; 19 ; Input GMPDFN Pointer to Patient file #2 20 ; GMPCOMP Display Comments 1/0 21 ; GMTSTAT Status A/I/"" 22 ; 23 ; Output GMPL Array, passed by reference 24 ; GMPL(#) 25 ; Piece 1: Pointer to Problem #9000011 26 ; 2: Status 27 ; 3: Description 28 ; 4: ICD-9 code 29 ; 5: Date of Onset 30 ; 6: Date Last Modified 31 ; 7: Service Connected 32 ; 8: Special Exposures 33 ; GMPL(#,C#) Comments 34 ; GMPL(0) Number of Problems Returned 35 ; 36 N I,IFN,CNT,GMPL0,GMPL1,SP,ST,NUM,ONSET,ICD,LASTMOD,SC,GMPLIST,GMPLVIEW,GMPARAM,GMPTOTAL 37 Q:$G(GMPDFN)'>0 S CNT=0,SP="" 38 S GMPARAM("QUIET")=1,GMPARAM("REV")=$P($G(^GMPL(125.99,1,0)),U,5)="R" 39 S GMPLVIEW("ACT")=GMPSTAT,GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")="" 40 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW) 41 F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D 42 . S IFN=+GMPLIST(NUM) Q:IFN'>0 43 . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)),CNT=CNT+1 44 . S ICD=$P($G(^ICD9(+GMPL0,0)),U),LASTMOD=$P(GMPL0,U,3) 45 . S ST=$P(GMPL0,U,12),ONSET=$P(GMPL0,U,13) 46 . S SC=$S(+$P(GMPL1,U,10):"SC",$P(GMPL1,U,10)=0:"NSC",1:"") 47 . N SCS D SCS^GMPLX1(IFN,.SCS) S SP=$G(SCS(3)) 48 . S GMPL(CNT)=IFN_U_ST_U_$$PROBTEXT^GMPLX(IFN)_U_ICD_U_ONSET_U_LASTMOD_U_SC_U_SP_U_$S($P(GMPL1,U,14)="A":"*",1:"")_U_$S('$P($G(^GMPL(125.99,1,0)),U,2):"",$P(GMPL1,U,2)'="T":"",1:"$") 49 . I $G(GMPCOMM) D 50 . . N FAC,NIFN,NOTE,NOTECNT 51 . . S NOTECNT=0,FAC=0 52 . . F S FAC=$O(^AUPNPROB(IFN,11,FAC)) Q:+FAC'>0 D 53 . . . S NIFN=0 54 . . . F S NIFN=$O(^AUPNPROB(IFN,11,FAC,11,NIFN)) Q:NIFN'>0 D 55 . . . . S NOTE=$P($G(^AUPNPROB(IFN,11,FAC,11,NIFN,0)),U,3) 56 . . . . S NOTECNT=NOTECNT+1,GMPL(CNT,NOTECNT)=NOTE 57 S GMPL(0)=CNT 58 Q 59 ; 60 DETAIL(IFN,GMPL) ; Returns Detailed Data for Problem 61 ; 62 ; Input IFN Pointer to Problem file #9000011 63 ; 64 ; Output GMPL Array, passed by reference 65 ; GMPL("DATA NAME") = External Format of Value 66 ; 67 ; GMPL("DIAGNOSIS") ICD Code 68 ; GMPL("PATIENT") Patient Name 69 ; GMPL("MODIFIED") Date Last Modified 70 ; GMPL("NARRATIVE") Provider Narrative 71 ; GMPL("ENTERED") Date Entered ^ Entered by 72 ; GMPL("STATUS") Status 73 ; GMPL("PRIORITY") Priority Acute/Chronic 74 ; GMPL("ONSET") Date of Onset 75 ; GMPL("PROVIDER") Responsible Provider 76 ; GMPL("RECORDED") Date Recorded ^ Recorded by 77 ; GMPL("CLINIC") Hospital Location 78 ; GMPL("SC") Service Connected SC/NSC/"" 79 ; 80 ; GMPL("EXPOSURE") = # 81 ; GMPL("EXPOSURE",X)="AGENT ORANGE" 82 ; GMPL("EXPOSURE",X)="RADIATION" 83 ; GMPL("EXPOSURE",X)="ENV CONTAMINANTS" 84 ; GMPL("EXPOSURE",X)="HEAD AND/OR NECK CANCER" 85 ; GMPL("EXPOSURE",X)="MILITARY SEXUAL TRAUMA" 86 ; 87 ; GMPL("COMMENT") = # 88 ; GMPL("COMMENT",CNT) = Date ^ Author ^ Text of Note 89 ; 90 N GMPL0,GMPL1,GMPLP,X,I,FAC,CNT,NIFN Q:'$D(^AUPNPROB(IFN,0)) 91 S GMPLP=+($$PTR^GMPLUTL4),GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)) 92 S GMPL("DIAGNOSIS")=$P($G(^ICD9(+GMPL0,0)),U) 93 S GMPL("PATIENT")=$P($G(^DPT(+$P(GMPL0,U,2),0)),U) 94 S GMPL("MODIFIED")=$$EXTDT^GMPLX($P(GMPL0,U,3)) 95 S GMPL("NARRATIVE")=$$PROBTEXT^GMPLX(IFN) 96 S GMPL("ENTERED")=$$EXTDT^GMPLX($P(GMPL0,U,8))_U_$P($G(^VA(200,+$P(GMPL1,U,3),0)),U) 97 S X=$P(GMPL0,U,12),GMPL("STATUS")=$S(X="A":"ACTIVE",1:"INACTIVE") 98 S X=$S(X'="A":"",1:$P(GMPL1,U,14)),GMPL("PRIORITY")=$S(X="A":"ACUTE",X="C":"CHRONIC",1:"") 99 S GMPL("ONSET")=$$EXTDT^GMPLX($P(GMPL0,U,13)) 100 S GMPL("PROVIDER")=$P($G(^VA(200,+$P(GMPL1,U,5),0)),U) 101 S GMPL("RECORDED")=$$EXTDT^GMPLX($P(GMPL1,U,9))_U_$P($G(^VA(200,+$P(GMPL1,U,4),0)),U) 102 S GMPL("CLINIC")=$P($G(^SC(+$P(GMPL1,U,8),0)),U) 103 S GMPL("SC")=$S($P(GMPL1,U,10):"YES",$P(GMPL1,U,10)=0:"NO",1:"UNKNOWN") 104 S GMPL("EXPOSURE")=0 105 I $P(GMPL1,U,11) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="AGENT ORANGE",GMPL("EXPOSURE")=X 106 I $P(GMPL1,U,12) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="RADIATION",GMPL("EXPOSURE")=X 107 I $P(GMPL1,U,13) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="ENV CONTAMINANTS",GMPL("EXPOSURE")=X 108 I $P(GMPL1,U,15) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="HEAD AND/OR NECK CANCER",GMPL("EXPOSURE")=X 109 I $P(GMPL1,U,16)&(GMPLP'>0) S X=GMPL("EXPOSURE")+1,GMPL("EXPOSURE",X)="MILITARY SEXUAL TRAUMA",GMPL("EXPOSURE")=X 110 S (FAC,CNT)=0,GMPL("COMMENT")=0 111 F FAC=0:0 S FAC=$O(^AUPNPROB(IFN,11,FAC)) Q:+FAC'>0 D 112 . F NIFN=0:0 S NIFN=$O(^AUPNPROB(IFN,11,FAC,11,NIFN)) Q:NIFN'>0 D 113 . . S X=$G(^AUPNPROB(IFN,11,FAC,11,NIFN,0)) 114 . . S CNT=CNT+1,GMPL("COMMENT",CNT)=$$EXTDT^GMPLX($P(X,U,5))_U_$P($G(^VA(200,+$P(X,U,6),0)),U)_U_$P(X,U,3) 115 S GMPL("COMMENT")=CNT D AUDIT 116 Q 117 ; 118 AUDIT ; 14 Sep 99 - MA - Add audit trail to OE Problem List. 119 ; Called from DETAIL, requires IFN and sets GMPL("AUDIT") 120 N IDT,AIFN,X0,X1,FLD,CNT 121 S CNT=0,GMPL("AUDIT")=CNT 122 F IDT=0:0 S IDT=$O(^GMPL(125.8,"AD",IFN,IDT)) Q:IDT'>0 D 123 . F AIFN=0:0 S AIFN=$O(^GMPL(125.8,"AD",IFN,IDT,AIFN)) Q:AIFN'>0 D 124 .. S X0=$G(^GMPL(125.8,AIFN,0)),X1=$G(^(1)) Q:'$L(X0) 125 .. S FLD=$$FLDNAME(+$P(X0,U,2)) 126 .. S CNT=CNT+1 127 .. S GMPL("AUDIT",CNT,0)=$P(X0,U,2)_U_FLD_U_$P(X0,U,3,8) 128 .. ; = pointer#^fld name^date mod^who mod^old^new^reason^prov 129 .. S:$L(X1) GMPL("AUDIT",CNT,1)=X1 130 S GMPL("AUDIT")=CNT 131 Q 132 ; 133 FLDNAME(NUM) ; Returns field name for display 134 N NAME,NM1,NM2,I,J S J=0,NAME="" 135 S NM1=".01^.05^.12^.13^1.01^1.02^1.04^1.05^1.06^1.07^1.08^1.09^1.1^1.11^1.12^1.13^1.14^1101" 136 F I=1:1:$L(NM1,U) I +$P(NM1,U,I)=+NUM S J=I Q 137 G:J'>0 FNQ 138 S NM2="DIAGNOSIS^PROVIDER NARRATIVE^STATUS^DATE OF ONSET^PROBLEM^CONDITION^RECORDING PROVIDER^RESPONSIBLE PROVIDER^SERVICE^DATE RESOLVED^CLINIC^DATE RECORDED^SERVICE CONNECTED^AGENT ORANGE EXP^RADIATION EXP^ENV CONTAMINANTS EXP^PRIORITY^NOTE" 139 S NAME=$P(NM2,U,J) 140 FNQ Q NAME 141 ; 142 ADD(DFN,LOC,GMPROV) ; -- Interactive LMgr action to add new problem 143 N X,Y,GMPDFN,GMPVA,GMPVAMC,GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPHNC,GMPMST 144 N GMPARAM,GMPLVIEW,GMPLUSER,GMPCLIN,GMPLSLST,GMPQUIT,VALMCC,GMPSAVED 145 Q:'DFN Q:'LOC D SETVARS 146 S GMPLSLST=$P($G(^VA(200,DUZ,125)),U,2),VALMCC=0 147 I 'GMPLSLST,GMPCLIN,$D(^GMPL(125,"C",+GMPCLIN)) S GMPLSLST=$O(^(+GMPCLIN,0)) 148 I GMPLSLST D Q 149 . S $P(GMPLSLST,U,2)=$P($G(^GMPL(125,+GMPLSLST,0)),U) 150 . D EN^VALM("GMPL LIST MENU") 151 F D ADD^GMPL1 Q:$D(GMPQUIT) K DUOUT,DTOUT,GMPSAVED W !!,">>> Please enter another problem, or press <return> to exit." 152 Q 153 ; 154 SETVARS ; -- Define GMP* variables used in ADD and EDIT 155 N VA,VADM,VAEL,VASV,X 156 Q:'DFN D DEM^VADPT,7^VADPT 157 S GMPDFN=DFN_U_VADM(1)_U_$E(VADM(1))_VA("BID")_$S(VADM(6):U_+VADM(6),1:"") 158 S AUPNSEX=$P(VADM(5),U),GMPVA=1,GMPSC=VAEL(3),GMPAGTOR=VASV(2),GMPION=VASV(3) 159 S X=$P($G(^DPT(DFN,.322)),U,10),GMPGULF=$S(X="Y":1,X="N":0,1:"") 160 S X=$$GETCUR^DGNTAPI(DFN,"HNC"),X=+($G(HNC("STAT"))),GMPHNC=$S(X=4:1,X=5:1,X=1:0,X=6:0,1:"") 161 S X=$P($$GETSTAT^DGMSTAPI(DFN),"^",2),GMPMST=$S(X="Y":1,X="N":0,1:"") 162 S GMPLVIEW("VIEW")=$S($P($G(^SC(+$G(LOC),0)),U,3)="C":"C",1:"S") 163 S GMPCLIN="" I $G(LOC),GMPLVIEW("VIEW")="C" S GMPCLIN=+LOC_U_$P(^SC(+LOC,0),U) 164 S X=$$PARAM,GMPARAM("VER")=+$P(X,U,2),GMPARAM("CLU")=+$P(X,U,4),GMPARAM("REV")=+$P(X,U,5) 165 S:+GMPROV=DUZ GMPLUSER=1 S GMPVAMC=+$G(DUZ(2)),GMPLIST(0)=0 166 Q 167 ; 168 EDIT(DFN,LOC,GMPROV,GMPIFN) ; Interactive LMgr action to edit a problem 169 N GMPARAM,GMPDFN,GMPVA,GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPHNC,GMPMST 170 N GMPLVIEW,GMPCLIN,GMPLJUMP,GMPQUIT,GMPLUSER,GMPLVAMC,AUPNSEX 171 L +^AUPNPROB(GMPIFN,0):1 I '$T W $C(7),!!,$$LOCKED^GMPLX,! H 2 Q 172 D SETVARS,EN^VALM("GMPL EDIT PROBLEM") 173 L -^AUPNPROB(GMPIFN,0) 174 Q 175 ; 176 REMOVE(GMPIFN,GMPROV,TEXT,PLY) ; -- Remove problem GMPIFN 177 N GMPVAMC,CHANGE 178 S GMPVAMC=+$G(DUZ(2)),PLY=-1,PLY(0)="" 179 I '$L($G(^AUPNPROB(GMPIFN,0))) S PLY(0)="Invalid problem" Q 180 I '$D(^VA(200,+$G(GMPROV),0)) S PLY(0)="Invalid provider" Q 181 I $L($G(TEXT)) S GMPFLD(10,"NEW",1)=TEXT D NEWNOTE^GMPLSAVE 182 S CHANGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($H)_U_DUZ_U_$P($G(^AUPNPROB(GMPIFN,1)),U,2)_"^H^Deleted^"_+$G(GMPROV),$P(^AUPNPROB(GMPIFN,1),U,2)="H",PLY=GMPIFN 183 D AUDIT^GMPLX(CHANGE,""),DTMOD^GMPLX(GMPIFN) 184 Q 185 ; 186 PARAM() ; -- Returns parameter values from 125.99 187 Q $G(^GMPL(125.99,1,0)) 188 ; 189 VAF(DFN,SILENT) ; -- print PL VA Form chart copy 190 ; 191 N VA,VADM,VAERR,GMPDFN,GMPVAMC,X,GMPARAM,GMPRT,GMPQUIT,GMPLCURR 192 Q:'$G(DFN) D DEM^VADPT S GMPDFN=DFN_U_VADM(1)_U_$E(VADM(1))_VA("BID") 193 S GMPVAMC=+$G(DUZ(2)),GMPARAM("QUIET")=1 194 S X=$G(^GMPL(125.99,1,0)),GMPARAM("VER")=+$P(X,U,2),GMPARAM("PRT")=+$P(X,U,3),GMPARAM("CLU")=+$P(X,U,4),GMPARAM("REV")=$S($P(X,U,5)="R":1,1:0) K X 195 D VAF^GMPLPRNT I '$G(SILENT) D Q:$G(GMPQUIT) 196 . I GMPRT'>0 W !!,"No problems available." S GMPQUIT=1 Q 197 . D DEVICE^GMPLPRNT Q:$G(GMPQUIT) D CLEAR^VALM1 198 D PRT^GMPLPRNT 199 Q
Note:
See TracChangeset
for help on using the changeset viewer.
