Changeset 623 for WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLEDT3.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLEDT3.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLEDT3.m
r613 r623 1 GMPLEDT3 ; SLC/MKB/KER -- Problem List edit utilities ; 04/15/2002 2 ;;2.0;Problem List;**26,35**;Aug 25, 1994;Build 26 3 ; 4 ; External References 5 ; DBIA 872 ^ORD(101 6 ; DBIA 10026 ^XUSEC("GMPL ICD CODE" 7 ; DBIA 10015 EN^DIQ1 8 ; DBIA 10026 ^DIR 9 ; DBIA 10104 $$UP^XLFSTR 10 ; 11 MSG() ; List Manager Message Bar 12 Q "Enter the number of the item(s) you wish to change" 13 ; 14 KEYS ; Setup XQORM("KEY") array 15 ; Numbers ref'd also in IN4^-EDIT, NTES^-EDT4 16 N I,PROTCL,NUM,ICD 17 S ICD=$S($D(^XUSEC("GMPL ICD CODE",DUZ)):1,1:0) 18 S XQORM("KEY","1")=$O(^ORD(101,"B","GMPL EDIT REFORMULATE",0))_"^1" 19 S XQORM("KEY","2")=$O(^ORD(101,"B","GMPL EDIT ONSET",0))_"^1" 20 S XQORM("KEY","3")=$O(^ORD(101,"B","GMPL EDIT STATUS",0))_"^1" 21 S XQORM("KEY","4")=$O(^ORD(101,"B","GMPL EDIT PROVIDER",0))_"^1" 22 S XQORM("KEY","5")=$O(^ORD(101,"B","GMPL EDIT SERVICE",0))_"^1",NUM=5 23 S:ICD XQORM("KEY","6")=$O(^ORD(101,"B","GMPL EDIT ICD",0))_"^1",NUM=6 24 I GMPVA D 25 . S NUM=NUM+1,XQORM("KEY",NUM)=$O(^ORD(101,"B","GMPL EDIT SC",0))_"^1" 26 . S NUM=NUM+1,XQORM("KEY",NUM)=$O(^ORD(101,"B","GMPL EDIT SP",0))_"^1" 27 S PROTCL=$O(^ORD(101,"B","GMPL EDIT NOTES",0))_"^1" 28 I GMPFLD(10,0) F I=1:1:GMPFLD(10,0) S NUM=NUM+1,XQORM("KEY",NUM)=PROTCL 29 S XQORM("KEY",NUM+1)=$O(^ORD(101,"B","GMPL EDIT NEW NOTE",0))_"^1" 30 S:$G(GMPARAM("VER"))&$D(GMPLUSER) XQORM("KEY","$")=$O(^ORD(101,"B","GMPL EDIT VERIFY",0))_"^1" 31 S XQORM("KEY","=")=$O(^ORD(101,"B","VALM NEXT SCREEN",0))_"^1" 32 S VALMSG=$$MSG 33 Q 34 ; 35 GETFLDS(DA) ; Define GMPFLD(#) and GMPORIG(#) Arrays with Current Values 36 N DIC,DIQ,DR,I,GMPL,CNT,NIFN,FAC,EXT 37 S DIC="^AUPNPROB(",DIQ="GMPL",DIQ(0)="IE" 38 S DR=".01;.03;.05;.08:1.02;1.05:1.18" D EN^DIQ1 39 F I=.01,.03,.05,.08,.12,.13,1.01,1.02,1.05,1.06,1.07,1.08,1.09,1.1,1.11,1.12,1.13,1.14,1.15,1.16,1.17,1.18 D 40 . S GMPORIG(I)=$G(GMPL(9000011,DA,I,"I")),EXT="" 41 . I I=1.01,GMPL(9000011,DA,I,"I")'>1 S GMPORIG(I)="" Q 42 . Q:(GMPORIG(I)="")!(I=1.02) 43 . I "^.01^.05^.12^1.01^1.05^1.06^1.08^1.1^1.14^"[(U_I_U) S EXT=GMPL(9000011,DA,I,"E") 44 . I "^.03^.08^.13^1.07^1.09^"[(U_I_U) S EXT=$$EXTDT^GMPLX(GMPORIG(I)) 45 . I "^1.11^1.12^1.13^"[(U_I_U) S EXT=$S(I=1.11:"AGENT ORANGE",I=1.12:"RADIATION",1:"ENV CONTAMINANTS") 46 . I "^1.15^1.16^1.17^1.18^"[(U_I_U) S EXT=$S(I=1.15:"HEAD/NECK CANCER",1=1.16:"MIL SEXUAL TRAUMA",1=1.17:"COMBAT VET",1:"SHAD") 47 . S GMPORIG(I)=GMPORIG(I)_U_EXT 48 S I=0 F S I=$O(GMPORIG(I)) Q:I'>0 S GMPFLD(I)=GMPORIG(I) 49 S (CNT,GMPORIG(10,0),GMPFLD(10,0))=0 50 S FAC=$O(^AUPNPROB(DA,11,"B",+GMPVAMC,0)) Q:'FAC 51 F NIFN=0:0 S NIFN=$O(^AUPNPROB(DA,11,FAC,11,"B",NIFN)) Q:NIFN'>0 D 52 . I '$D(GMPLMGR),$P($G(^AUPNPROB(DA,11,FAC,11,NIFN,0)),U,6)'=+GMPROV Q 53 . S CNT=CNT+1,GMPORIG(10,CNT)=$G(^AUPNPROB(DA,11,FAC,11,NIFN,0)) 54 . S $P(GMPORIG(10,CNT),U,2)=FAC 55 . S GMPFLD(10,CNT)=GMPORIG(10,CNT) 56 S (GMPORIG(10,0),GMPFLD(10,0))=CNT 57 Q 58 ; 59 FLDS ; Define GMPFLD("FLD") Array for Editing 60 S (GMPFLD("FLD",2),GMPFLD("FLD",6),GMPFLD("FLD",7))="Q" 61 S GMPFLD("FLD",1)="TERM",GMPFLD("FLD","PROBLEM")=1 62 S:$D(^XUSEC("GMPL ICD CODE",DUZ)) GMPFLD("FLD",2)="ICD",GMPFLD("FLD","ICD CODE")=2 63 S GMPFLD("FLD",3)="NOTE",GMPFLD("FLD","COMMENT")=3 64 S GMPFLD("FLD",4)="ONSET",GMPFLD("FLD","DATE OF ONSET")=4 65 S GMPFLD("FLD",5)="STATUS",GMPFLD("FLD","STATUS")=5 66 S:GMPSC GMPFLD("FLD",6)="SC",GMPFLD("FLD","IS THIS PROBLEM RELATED TO A SERVICE-CONNECTED CONDITION?")=6 67 S:GMPAGTOR GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO AGENT ORANGE EXPOSURE?")=7 68 S:GMPION GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO RADIATION EXPOSURE?")=7 69 S:GMPGULF GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO ENVIRONMENTAL CONTAMINANTS EXPOSURE?")=7 70 S:GMPHNC GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO DIAGNOSED HEAD AND/OR NECK CANCER?")=7 71 S:GMPMST GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO REPORTED MILITARY SEXUAL TRAUMA?")=7 72 S:GMPCV GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO REPORTED COMBAT VET?")=7 73 S:GMPSHD GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO REPORTED SHIPBOARD HAZARD AND DEFENSE?")=7 74 S GMPFLD("FLD",8)="PROV",GMPFLD("FLD","RESPONSIBLE PROVIDER")=8 75 S GMPFLD("FLD",9)="SOURCE" 76 S:$E(GMPLVIEW("VIEW"))="C" GMPFLD("FLD","CLINIC")=9 77 S:$E(GMPLVIEW("VIEW"))'="C" GMPFLD("FLD","SERVICE")=9 78 S GMPFLD("FLD",10)="RECORDED",GMPFLD("FLD","DATE RECORDED")=10 79 S GMPFLD("FLD",11)="AUTHOR",GMPFLD("FLD","RECORDING PROVIDER")=11 80 S GMPFLD("FLD",0)=11 81 Q 82 ; 83 JUMP(XFLD) ; Resolve ^- Jump Out of Field Order in Edit 84 N I,MATCH,CNT,PROMPT,DIR,X,Y 85 ; Passed in as ^XXX 86 S XFLD=$$UP^XLFSTR($P(XFLD,U,2)) 87 I (XFLD="")!(XFLD["^") S GMPQUIT=1 Q 88 I '$D(GMPLJUMP) W $C(7)," ^-jumping not allowed now!" S GMPLJUMP=0 Q 89 ; Field is Exact 90 I $G(GMPFLD("FLD",XFLD)) S GMPLJUMP=GMPFLD("FLD",XFLD) Q 91 S CNT=0,PROMPT=" " 92 F S PROMPT=$O(GMPFLD("FLD",PROMPT)) Q:PROMPT="" D 93 . Q:$E(PROMPT,1,$L(XFLD))'=XFLD 94 . S CNT=CNT+1,MATCH(CNT)=GMPFLD("FLD",PROMPT)_U_PROMPT 95 I CNT=0 W $C(7)," ??" Q 96 I CNT=1 S PROMPT=$P(MATCH(1),U,2),GMPLJUMP=+MATCH(1) W $E(PROMPT,$L(XFLD)+1,$L(PROMPT)) Q 97 ; Select which Field to Jump To. 98 F I=1:1:CNT S DIR("A",I)=I_" "_$P(MATCH(I),U,2) 99 S DIR("A")="Select 1-"_CNT_": ",DIR(0)="NAO^1:"_CNT 100 S DIR("?")="Select the field you wish to jump to, by number" 101 D ^DIR I $D(DTOUT)!($D(DUOUT))!(Y="") Q 102 S GMPLJUMP=+MATCH(+Y) 103 Q 104 ; 105 CK ; Check whether to Stop Processing 106 ; Called from Exit Action of GMPL EDIT XXX Protocols 107 S:$D(GMPQUIT) XQORPOP=1 S:'$D(GMPQUIT) GMPREBLD=1 K GMPQUIT 108 I $D(DTOUT)!($G(VALMBCK)="Q") S VALMBCK="Q" Q 109 S VALMBCK="R",VALMSG=$$MSG 110 Q 1 GMPLEDT3 ; SLC/MKB/KER -- Problem List edit utilities ; 04/15/2002 2 ;;2.0;Problem List;**26**;Aug 25, 1994 3 ; 4 ; External References 5 ; DBIA 872 ^ORD(101 6 ; DBIA 10026 ^XUSEC("GMPL ICD CODE" 7 ; DBIA 10015 EN^DIQ1 8 ; DBIA 10026 ^DIR 9 ; DBIA 10104 $$UP^XLFSTR 10 ; 11 MSG() ; List Manager Message Bar 12 Q "Enter the number of the item(s) you wish to change" 13 ; 14 KEYS ; Setup XQORM("KEY") array 15 ; Numbers ref'd also in IN4^-EDIT, NTES^-EDT4 16 N I,PROTCL,NUM,ICD 17 S ICD=$S($D(^XUSEC("GMPL ICD CODE",DUZ)):1,1:0) 18 S XQORM("KEY","1")=$O(^ORD(101,"B","GMPL EDIT REFORMULATE",0))_"^1" 19 S XQORM("KEY","2")=$O(^ORD(101,"B","GMPL EDIT ONSET",0))_"^1" 20 S XQORM("KEY","3")=$O(^ORD(101,"B","GMPL EDIT STATUS",0))_"^1" 21 S XQORM("KEY","4")=$O(^ORD(101,"B","GMPL EDIT PROVIDER",0))_"^1" 22 S XQORM("KEY","5")=$O(^ORD(101,"B","GMPL EDIT SERVICE",0))_"^1",NUM=5 23 S:ICD XQORM("KEY","6")=$O(^ORD(101,"B","GMPL EDIT ICD",0))_"^1",NUM=6 24 I GMPVA D 25 . S NUM=NUM+1,XQORM("KEY",NUM)=$O(^ORD(101,"B","GMPL EDIT SC",0))_"^1" 26 . S NUM=NUM+1,XQORM("KEY",NUM)=$O(^ORD(101,"B","GMPL EDIT SP",0))_"^1" 27 S PROTCL=$O(^ORD(101,"B","GMPL EDIT NOTES",0))_"^1" 28 I GMPFLD(10,0) F I=1:1:GMPFLD(10,0) S NUM=NUM+1,XQORM("KEY",NUM)=PROTCL 29 S XQORM("KEY",NUM+1)=$O(^ORD(101,"B","GMPL EDIT NEW NOTE",0))_"^1" 30 S:$G(GMPARAM("VER"))&$D(GMPLUSER) XQORM("KEY","$")=$O(^ORD(101,"B","GMPL EDIT VERIFY",0))_"^1" 31 S XQORM("KEY","=")=$O(^ORD(101,"B","VALM NEXT SCREEN",0))_"^1" 32 S VALMSG=$$MSG 33 Q 34 ; 35 GETFLDS(DA) ; Define GMPFLD(#) and GMPORIG(#) Arrays with Current Values 36 N DIC,DIQ,DR,I,GMPL,CNT,NIFN,FAC,EXT 37 S DIC="^AUPNPROB(",DIQ="GMPL",DIQ(0)="IE" 38 S DR=".01;.03;.05;.08:1.02;1.05:1.16" D EN^DIQ1 39 F I=.01,.03,.05,.08,.12,.13,1.01,1.02,1.05,1.06,1.07,1.08,1.09,1.1,1.11,1.12,1.13,1.14,1.15,1.16 D 40 . S GMPORIG(I)=$G(GMPL(9000011,DA,I,"I")),EXT="" 41 . I I=1.01,GMPL(9000011,DA,I,"I")'>1 S GMPORIG(I)="" Q 42 . Q:(GMPORIG(I)="")!(I=1.02) 43 . I "^.01^.05^.12^1.01^1.05^1.06^1.08^1.1^1.14^"[(U_I_U) S EXT=GMPL(9000011,DA,I,"E") 44 . I "^.03^.08^.13^1.07^1.09^"[(U_I_U) S EXT=$$EXTDT^GMPLX(GMPORIG(I)) 45 . I "^1.11^1.12^1.13^"[(U_I_U) S EXT=$S(I=1.11:"AGENT ORANGE",I=1.12:"RADIATION",1:"ENV CONTAMINANTS") 46 . I "^1.15^1.16^"[(U_I_U) S EXT=$S(I=1.15:"HEAD/NECK CANCER",1:"MIL SEXUAL TRAUMA") 47 . S GMPORIG(I)=GMPORIG(I)_U_EXT 48 S I=0 F S I=$O(GMPORIG(I)) Q:I'>0 S GMPFLD(I)=GMPORIG(I) 49 S (CNT,GMPORIG(10,0),GMPFLD(10,0))=0 50 S FAC=$O(^AUPNPROB(DA,11,"B",+GMPVAMC,0)) Q:'FAC 51 F NIFN=0:0 S NIFN=$O(^AUPNPROB(DA,11,FAC,11,"B",NIFN)) Q:NIFN'>0 D 52 . I '$D(GMPLMGR),$P($G(^AUPNPROB(DA,11,FAC,11,NIFN,0)),U,6)'=+GMPROV Q 53 . S CNT=CNT+1,GMPORIG(10,CNT)=$G(^AUPNPROB(DA,11,FAC,11,NIFN,0)) 54 . S $P(GMPORIG(10,CNT),U,2)=FAC 55 . S GMPFLD(10,CNT)=GMPORIG(10,CNT) 56 S (GMPORIG(10,0),GMPFLD(10,0))=CNT 57 Q 58 ; 59 FLDS ; Define GMPFLD("FLD") Array for Editing 60 S (GMPFLD("FLD",2),GMPFLD("FLD",6),GMPFLD("FLD",7))="Q" 61 S GMPFLD("FLD",1)="TERM",GMPFLD("FLD","PROBLEM")=1 62 S:$D(^XUSEC("GMPL ICD CODE",DUZ)) GMPFLD("FLD",2)="ICD",GMPFLD("FLD","ICD CODE")=2 63 S GMPFLD("FLD",3)="NOTE",GMPFLD("FLD","COMMENT")=3 64 S GMPFLD("FLD",4)="ONSET",GMPFLD("FLD","DATE OF ONSET")=4 65 S GMPFLD("FLD",5)="STATUS",GMPFLD("FLD","STATUS")=5 66 S:GMPSC GMPFLD("FLD",6)="SC",GMPFLD("FLD","IS THIS PROBLEM RELATED TO A SERVICE-CONNECTED CONDITION?")=6 67 S:GMPAGTOR GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO AGENT ORANGE EXPOSURE?")=7 68 S:GMPION GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO RADIATION EXPOSURE?")=7 69 S:GMPGULF GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO ENVIRONMENTAL CONTAMINANTS EXPOSURE?")=7 70 S:GMPHNC GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO DIAGNOSED HEAD AND/OR NECK CANCER?")=7 71 S:GMPMST GMPFLD("FLD",7)="SP",GMPFLD("FLD","IS THIS PROBLEM RELATED TO REPORTED MILITARY SEXUAL TRAUMA?")=7 72 S GMPFLD("FLD",8)="PROV",GMPFLD("FLD","RESPONSIBLE PROVIDER")=8 73 S GMPFLD("FLD",9)="SOURCE" 74 S:$E(GMPLVIEW("VIEW"))="C" GMPFLD("FLD","CLINIC")=9 75 S:$E(GMPLVIEW("VIEW"))'="C" GMPFLD("FLD","SERVICE")=9 76 S GMPFLD("FLD",10)="RECORDED",GMPFLD("FLD","DATE RECORDED")=10 77 S GMPFLD("FLD",11)="AUTHOR",GMPFLD("FLD","RECORDING PROVIDER")=11 78 S GMPFLD("FLD",0)=11 79 Q 80 ; 81 JUMP(XFLD) ; Resolve ^- Jump Out of Field Order in Edit 82 N I,MATCH,CNT,PROMPT,DIR,X,Y 83 ; Passed in as ^XXX 84 S XFLD=$$UP^XLFSTR($P(XFLD,U,2)) 85 I (XFLD="")!(XFLD["^") S GMPQUIT=1 Q 86 I '$D(GMPLJUMP) W $C(7)," ^-jumping not allowed now!" S GMPLJUMP=0 Q 87 ; Field is Exact 88 I $G(GMPFLD("FLD",XFLD)) S GMPLJUMP=GMPFLD("FLD",XFLD) Q 89 S CNT=0,PROMPT=" " 90 F S PROMPT=$O(GMPFLD("FLD",PROMPT)) Q:PROMPT="" D 91 . Q:$E(PROMPT,1,$L(XFLD))'=XFLD 92 . S CNT=CNT+1,MATCH(CNT)=GMPFLD("FLD",PROMPT)_U_PROMPT 93 I CNT=0 W $C(7)," ??" Q 94 I CNT=1 S PROMPT=$P(MATCH(1),U,2),GMPLJUMP=+MATCH(1) W $E(PROMPT,$L(XFLD)+1,$L(PROMPT)) Q 95 ; Select which Field to Jump To. 96 F I=1:1:CNT S DIR("A",I)=I_" "_$P(MATCH(I),U,2) 97 S DIR("A")="Select 1-"_CNT_": ",DIR(0)="NAO^1:"_CNT 98 S DIR("?")="Select the field you wish to jump to, by number" 99 D ^DIR I $D(DTOUT)!($D(DUOUT))!(Y="") Q 100 S GMPLJUMP=+MATCH(+Y) 101 Q 102 ; 103 CK ; Check whether to Stop Processing 104 ; Called from Exit Action of GMPL EDIT XXX Protocols 105 S:$D(GMPQUIT) XQORPOP=1 S:'$D(GMPQUIT) GMPREBLD=1 K GMPQUIT 106 I $D(DTOUT)!($G(VALMBCK)="Q") S VALMBCK="Q" Q 107 S VALMBCK="R",VALMSG=$$MSG 108 Q
Note:
See TracChangeset
for help on using the changeset viewer.
