Changeset 623 for WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLUTL1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLUTL1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLUTL1.m
r613 r623 1 GMPLUTL1 ; SLC/MKB/KER -- PL Utilities (cont) ; 04/15/2002 2 ;;2.0;Problem List;**3,8,7,9,26,35**;Aug 25, 1994;Build 26 3 ; 4 ; External References 5 ; DBIA 446 ^AUTNPOV( 6 ; DBIA 10082 ^ICD9( 7 ; DBIA 1571 ^LEX(757.01 8 ; DBIA 10040 ^SC( 9 ; DBIA 10060 ^VA(200 10 ; DBIA 10003 ^%DT 11 ; DBIA 10104 $$UP^XLFSTR 12 ; 13 ; All entry points in this routine expect the 14 ; PL("data item") array from routine ^GMPLUTL. 15 ; 16 ; Entry Expected Variable 17 ; Point From VADPT^GMPLX1 18 ; AO GMPAGTOR 19 ; IR GMPION 20 ; EC GMPGULF 21 ; HNC GMPHNC 22 ; MST GMPMST 23 ; CV GMPCV 24 ; SHD GMPSHD 25 ; 26 Q 27 DIAGNOSI ; ICD Diagnosis Pointer 28 S:'$L($G(PL("DIAGNOSIS"))) PL("DIAGNOSIS")=$$NOS^GMPLX 29 Q:$D(^ICD9(+PL("DIAGNOSIS"),0)) 30 S GMPQUIT=1,PLY(0)="Invalid ICD Diagnosis" 31 Q 32 ; 33 LEXICON ; Clinical Lexicon Pointer 34 S:'$L($G(PL("LEXICON"))) PL("LEXICON")=1 35 Q:$D(^LEX(757.01,+PL("LEXICON"),0)) 36 S GMPQUIT=1,PLY(0)="Invalid Lexicon term" 37 Q 38 DUPLICAT ; Problem Already on the List 39 N DUPL 40 Q:$P($G(^GMPL(125.99,1,0)),U,6)'=1 41 S:'$L($G(PL("DIAGNOSIS"))) PL("DIAGNOSIS")=$$NOS^GMPLX 42 I '$D(^AUPNPROB("B",+PL("DIAGNOSIS")))!('$D(^AUPNPROB("AC",GMPDFN))) Q 43 F IFN=0:0 S IFN=$O(^AUPNPROB("AC",GMPDFN,IFN)) Q:IFN'>0 D Q:$D(GMPQUIT) 44 . S (DUPL(1),DUPL(2))=0 45 . S NODE0=$G(^AUPNPROB(IFN,0)),NODE1=$G(^(1)) Q:$P(NODE1,U,2)="H" 46 . I +PL("DIAGNOSIS")=+NODE0 S DUPL(1)=IFN 47 . S:PL("NARRATIVE")=$$UP^XLFSTR($P(^AUTNPOV($P(NODE0,U,5),0),U)) DUPL(2)=IFN 48 . I DUPL(1)>0&DUPL(2)>0 S GMPQUIT=1,PLY(0)="Duplicate problem" 49 Q 50 ; 51 LOCATION ; Hospital Location (Clinic) Pointer 52 S:'$D(PL("LOCATION")) PL("LOCATION")="" Q:'$L(PL("LOCATION")) 53 I $D(^SC(+PL("LOCATION"),0)),$P(^(0),U,3)="C" Q 54 S GMPQUIT=1,PLY(0)="Invalid hospital location" 55 Q 56 ; 57 PROVIDER ; Responsible Provider 58 S:'$D(PL("PROVIDER")) PL("PROVIDER")="" 59 Q:'$L(PL("PROVIDER")) Q:$D(^VA(200,+PL("PROVIDER"),0)) 60 S GMPQUIT=1,PLY(0)="Invalid provider" 61 Q 62 ; 63 STATUS ; Problem Status 64 S:$G(PL("STATUS"))="" PL("STATUS")="A" 65 I "^A^I^a^i^"[(U_PL("STATUS")_U) S PL("STATUS")=$$UP^XLFSTR(PL("STATUS")) Q 66 S GMPQUIT=1,PLY(0)="Invalid problem status" 67 Q 68 ; 69 ONSET ; Date of Onset 70 N %DT,Y,X 71 S:'$D(PL("ONSET")) PL("ONSET")="" Q:'$L(PL("ONSET")) 72 S %DT="P",%DT(0)="-NOW",X=PL("ONSET") D ^%DT 73 I Y>0 S PL("ONSET")=Y Q 74 S GMPQUIT=1,PLY(0)="Invalid Date of Onset" 75 Q 76 ; 77 RESOLVED ; Date Resolved (Requires STATUS, ONSET) 78 N %DT,Y,X 79 S:'$D(PL("RESOLVED")) PL("RESOLVED")="" Q:'$L(PL("RESOLVED")) 80 S %DT="P",%DT(0)="-NOW",X=PL("RESOLVED") D ^%DT 81 I Y'>0 S GMPQUIT=1,PLY(0)="Invalid Date Resolved" Q 82 I PL("STATUS")="A" S GMPQUIT=1,PLY(0)="Active problems cannot have a Date Resolved" Q 83 I Y<PL("ONSET") S GMPQUIT=1,PLY(0)="Date Resolved cannot be prior to Date of Onset" Q 84 S PL("RESOLVED")=Y 85 Q 86 ; 87 RECORDED ; Date Recorded (Requires ONSET) 88 N %DT,Y,X 89 S:'$D(PL("RECORDED")) PL("RECORDED")="" Q:'$L(PL("RECORDED")) 90 S %DT="P",%DT(0)="-NOW",X=PL("RECORDED") D ^%DT 91 I Y'>0 S GMPQUIT=1,PLY(0)="Invalid Date Recorded" Q 92 I PL("RECORDED")<PL("ONSET") S GMPQUIT=1,PLY(0)="Date Recorded cannot be prior to Date of Onset" Q 93 S PL("RECORDED")=Y 94 Q 95 ; 96 SC ; SC condition flag 97 S:'$D(PL("SC")) PL("SC")="" 98 I "^^1^0^"'[(U_PL("SC")_U) S GMPQUIT=1,PLY(0)="Invalid SC flag" Q 99 I 'GMPSC,+PL("SC") S GMPQUIT=1,PLY(0)="Invalid SC flag" 100 Q 101 ; 102 AO ; AO exposure flag (Requires GMPAGTOR) 103 S:'$D(PL("AO")) PL("AO")="" 104 I "^^1^0^"'[(U_PL("AO")_U) S GMPQUIT=1,PLY(0)="Invalid AO flag" Q 105 I 'GMPAGTOR,+PL("AO") S GMPQUIT=1,PLY(0)="Invalid AO flag" 106 Q 107 ; 108 IR ; IR exposure flag (Requires GMPION) 109 S:'$D(PL("IR")) PL("IR")="" 110 I "^^1^0^"'[(U_PL("IR")_U) S GMPQUIT=1,PLY(0)="Invalid IR flag" Q 111 I 'GMPION,+PL("IR") S GMPQUIT=1,PLY(0)="Invalid IR flag" 112 Q 113 ; 114 EC ; EC exposure flag (Requires GMPGULF) 115 S:'$D(PL("EC")) PL("EC")="" 116 I "^^1^0^"'[(U_PL("EC")_U) S GMPQUIT=1,PLY(0)="Invalid EC flag" Q 117 I 'GMPGULF,+PL("EC") S GMPQUIT=1,PLY(0)="Invalid EC flag" 118 Q 119 HNC ; HNC/NTR exposure flag (Requires GMPHNC) 120 S:'$D(PL("HNC")) PL("HNC")="" 121 I "^^1^0^"'[(U_PL("HNC")_U) S GMPQUIT=1,PLY(0)="Invalid HNC flag" Q 122 I 'GMPHNC,+PL("HNC") S GMPQUIT=1,PLY(0)="Invalid HNC flag" 123 Q 124 MST ; MST exposure flag (Requires GMPMST) 125 S:'$D(PL("MST")) PL("MST")="" 126 I "^^1^0^"'[(U_PL("MST")_U) S GMPQUIT=1,PLY(0)="Invalid MST flag" Q 127 I 'GMPMST,+PL("MST") S GMPQUIT=1,PLY(0)="Invalid MST flag" 128 Q 129 CV ; CV exposure flag (Requires GMPCV) 130 S:'$D(PL("CV")) PL("CV")="" 131 I "^^1^0^"'[(U_PL("CV")_U) S GMPQUIT=1,PLY(0)="Invalid CV flag" Q 132 I 'GMPSHD,+PL("CV") S GMPQUIT=1,PLY(0)="Invalid CV flag" 133 Q 134 SHD ; SHD exposure flag (Requires GMPSHD) 135 S:'$D(PL("SHD")) PL("SHD")="" 136 I "^^1^0^"'[(U_PL("SHD")_U) S GMPQUIT=1,PLY(0)="Invalid SHD flag" Q 137 I 'GMPSHD,+PL("SHD") S GMPQUIT=1,PLY(0)="Invalid SHD flag" 138 Q 1 GMPLUTL1 ; SLC/MKB/KER -- PL Utilities (cont) ; 04/15/2002 2 ;;2.0;Problem List;**3,8,7,9,26**;Aug 25, 1994;Build 1 3 ; 4 ; External References 5 ; DBIA 446 ^AUTNPOV( 6 ; DBIA 10082 ^ICD9( 7 ; DBIA 1571 ^LEX(757.01 8 ; DBIA 10040 ^SC( 9 ; DBIA 10060 ^VA(200 10 ; DBIA 10003 ^%DT 11 ; DBIA 10104 $$UP^XLFSTR 12 ; 13 ; All entry points in this routine expect the 14 ; PL("data item") array from routine ^GMPLUTL. 15 ; 16 ; Entry Expected Variable 17 ; Point From VADPT^GMPLX1 18 ; AO GMPAGTOR 19 ; IR GMPION 20 ; EC GMPGULF 21 ; HNC GMPHNC 22 ; MST GMPMST 23 ; 24 Q 25 DIAGNOSI ; ICD Diagnosis Pointer 26 S:'$L($G(PL("DIAGNOSIS"))) PL("DIAGNOSIS")=$$NOS^GMPLX 27 Q:$D(^ICD9(+PL("DIAGNOSIS"),0)) 28 S GMPQUIT=1,PLY(0)="Invalid ICD Diagnosis" 29 Q 30 ; 31 LEXICON ; Clinical Lexicon Pointer 32 S:'$L($G(PL("LEXICON"))) PL("LEXICON")=1 33 Q:$D(^LEX(757.01,+PL("LEXICON"),0)) 34 S GMPQUIT=1,PLY(0)="Invalid Lexicon term" 35 Q 36 DUPLICAT ; Problem Already on the List 37 Q:$P($G(^GMPL(125.99,1,0)),U,6)'=1 38 S:'$L($G(PL("DIAGNOSIS"))) PL("DIAGNOSIS")=$$NOS^GMPLX 39 I '$D(^AUPNPROB("B",+PL("DIAGNOSIS")))!('$D(^AUPNPROB("AC",GMPDFN))) Q 40 F IFN=0:0 S IFN=$O(^AUPNPROB("AC",GMPDFN,IFN)) Q:IFN'>0 D Q:$D(GMPQUIT) 41 . S (DUPL(1),DUPL(2))=0 42 . S NODE0=$G(^AUPNPROB(IFN,0)),NODE1=$G(^(1)) Q:$P(NODE1,U,2)="H" 43 . I +PL("DIAGNOSIS")=+NODE0 S DUPL(1)=IFN 44 . S:PL("NARRATIVE")=$$UP^XLFSTR($P(^AUTNPOV($P(NODE0,U,5),0),U)) DUPL(2)=IFN 45 . I DUPL(1)>0&DUPL(2)>0 S GMPQUIT=1,PLY(0)="Duplicate problem" 46 Q 47 ; 48 LOCATION ; Hospital Location (Clinic) Pointer 49 S:'$D(PL("LOCATION")) PL("LOCATION")="" Q:'$L(PL("LOCATION")) 50 I $D(^SC(+PL("LOCATION"),0)),$P(^(0),U,3)="C" Q 51 S GMPQUIT=1,PLY(0)="Invalid hospital location" 52 Q 53 ; 54 PROVIDER ; Responsible Provider 55 S:'$D(PL("PROVIDER")) PL("PROVIDER")="" 56 Q:'$L(PL("PROVIDER")) Q:$D(^VA(200,+PL("PROVIDER"),0)) 57 S GMPQUIT=1,PLY(0)="Invalid provider" 58 Q 59 ; 60 STATUS ; Problem Status 61 S:$G(PL("STATUS"))="" PL("STATUS")="A" 62 I "^A^I^a^i^"[(U_PL("STATUS")_U) S PL("STATUS")=$$UP^XLFSTR(PL("STATUS")) Q 63 S GMPQUIT=1,PLY(0)="Invalid problem status" 64 Q 65 ; 66 ONSET ; Date of Onset 67 N %DT,Y,X 68 S:'$D(PL("ONSET")) PL("ONSET")="" Q:'$L(PL("ONSET")) 69 S %DT="P",%DT(0)="-NOW",X=PL("ONSET") D ^%DT 70 I Y>0 S PL("ONSET")=Y Q 71 S GMPQUIT=1,PLY(0)="Invalid Date of Onset" 72 Q 73 ; 74 RESOLVED ; Date Resolved (Requires STATUS, ONSET) 75 N %DT,Y,X 76 S:'$D(PL("RESOLVED")) PL("RESOLVED")="" Q:'$L(PL("RESOLVED")) 77 S %DT="P",%DT(0)="-NOW",X=PL("RESOLVED") D ^%DT 78 I Y'>0 S GMPQUIT=1,PLY(0)="Invalid Date Resolved" Q 79 I PL("STATUS")="A" S GMPQUIT=1,PLY(0)="Active problems cannot have a Date Resolved" Q 80 I Y<PL("ONSET") S GMPQUIT=1,PLY(0)="Date Resolved cannot be prior to Date of Onset" Q 81 S PL("RESOLVED")=Y 82 Q 83 ; 84 RECORDED ; Date Recorded (Requires ONSET) 85 N %DT,Y,X 86 S:'$D(PL("RECORDED")) PL("RECORDED")="" Q:'$L(PL("RECORDED")) 87 S %DT="P",%DT(0)="-NOW",X=PL("RECORDED") D ^%DT 88 I Y'>0 S GMPQUIT=1,PLY(0)="Invalid Date Recorded" Q 89 I PL("RECORDED")<PL("ONSET") S GMPQUIT=1,PLY(0)="Date Recorded cannot be prior to Date of Onset" Q 90 S PL("RECORDED")=Y 91 Q 92 ; 93 SC ; SC condition flag 94 S:'$D(PL("SC")) PL("SC")="" 95 I "^^1^0^"'[(U_PL("SC")_U) S GMPQUIT=1,PLY(0)="Invalid SC flag" Q 96 I 'GMPSC,+PL("SC") S GMPQUIT=1,PLY(0)="Invalid SC flag" 97 Q 98 ; 99 AO ; AO exposure flag (Requires GMPAGTOR) 100 S:'$D(PL("AO")) PL("AO")="" 101 I "^^1^0^"'[(U_PL("AO")_U) S GMPQUIT=1,PLY(0)="Invalid AO flag" Q 102 I 'GMPAGTOR,+PL("AO") S GMPQUIT=1,PLY(0)="Invalid AO flag" 103 Q 104 ; 105 IR ; IR exposure flag (Requires GMPION) 106 S:'$D(PL("IR")) PL("IR")="" 107 I "^^1^0^"'[(U_PL("IR")_U) S GMPQUIT=1,PLY(0)="Invalid IR flag" Q 108 I 'GMPION,+PL("IR") S GMPQUIT=1,PLY(0)="Invalid IR flag" 109 Q 110 ; 111 EC ; EC exposure flag (Requires GMPGULF) 112 S:'$D(PL("EC")) PL("EC")="" 113 I "^^1^0^"'[(U_PL("EC")_U) S GMPQUIT=1,PLY(0)="Invalid EC flag" Q 114 I 'GMPGULF,+PL("EC") S GMPQUIT=1,PLY(0)="Invalid EC flag" 115 Q 116 HNC ; HNC/NTR exposure flag (Requires GMPHNC) 117 S:'$D(PL("HNC")) PL("HNC")="" 118 I "^^1^0^"'[(U_PL("HNC")_U) S GMPQUIT=1,PLY(0)="Invalid HNC flag" Q 119 I 'GMPHNC,+PL("HNC") S GMPQUIT=1,PLY(0)="Invalid HNC flag" 120 Q 121 MST ; MST exposure flag (Requires GMPMST) 122 S:'$D(PL("MST")) PL("MST")="" 123 I "^^1^0^"'[(U_PL("MST")_U) S GMPQUIT=1,PLY(0)="Invalid MST flag" Q 124 I 'GMPMST,+PL("MST") S GMPQUIT=1,PLY(0)="Invalid MST flag" 125 Q
Note:
See TracChangeset
for help on using the changeset viewer.
