source: WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLENFM.m@ 613

Last change on this file since 613 was 613, checked in by George Lilly, 14 years ago

initial load of WorldVistAEHR
File size: 5.2 KB
Line 
1GMPLENFM ; SLC/MKB/KER -- Problem List Enc Form utilities ; 04/15/2002
2 ;;2.0;Problem List;**3,4,7,26,35**;Aug 25, 1994;Build 26
3 ;
4 ; External References
5 ; DBIA 10082 ^ICD9(
6 ; DBIA 10006 ^DIC
7 ; DBIA 1609 CONFIG^LEXSET
8 ;
9ACTIVE ; List of Active Problems for DFN
10 ; Sets Global Array:
11 ; ^TMP("IB",$J,"INTERFACES",DFN,"GMP PATIENT ACTIVE PROBLEMS",#) =
12 ;
13 ; Piece 1: Problem text
14 ; 2: ICD code
15 ; 3: Date of Onset 00/00/00 format
16 ; 4: SC/NSC/"" serv-conn/not sc/unknown
17 ; 5: Y/N/"" serv-conn/not sc/unknown
18 ; 6: A/I/E/H/M/C/S/"" If problem is flagged as:
19 ; A - Agent Orange
20 ; I - Ionizing Radiation
21 ; E - Environmental Contaminants
22 ; H - Head/Neck Cancer
23 ; M - Mil Sexual Trauma
24 ; C - Combat Vet
25 ; S - SHAD
26 ; - None
27 ; 7: Special Exposure Full text of piece 6
28 ;
29 N IFN,PROB,CNT,GMPL0,GMPL1,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL
30 N GMPDFN,NODE
31 Q:$G(DFN)'>0 S GMPDFN=DFN,CNT=0,NODE=$G(^GMPL(125.99,1,0))
32 S GMPARAM("VER")=$P(NODE,U,2),GMPARAM("REV")=$P(NODE,U,5)="R",GMPARAM("QUIET")=1
33 S GMPLVIEW("ACT")="A",GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")=""
34 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)
35 F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D
36 . S IFN=GMPLIST(NUM) Q:IFN'>0
37 . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1))
38 . S PROB=$$PROBTEXT^GMPLX(IFN),CNT=CNT+1
39 . I GMPARAM("VER"),$P(GMPL1,U,2)="T" S PROB="$"_PROB
40 . S PROB=PROB_U_$P($G(^ICD9(+$P(GMPL0,U),0)),U)
41 . S PROB=PROB_U_$$EXTDT^GMPLX($P(GMPL0,U,13)),SC=$P(GMPL1,U,10)
42 . S PROB=PROB_U_$S(+SC:"SC^Y",SC=0:"NSC^N",1:"^")
43 . S PROB=PROB_U_$$GMPL1
44 . ;S PROB=PROB_U_$S($P(GMPL1,U,11):"A^Agent Orange",$P(GMPL1,U,12):"I^Ionizing Radiation",$P(GMPL1,U,13):"E^Env. Contaminants"
45 . ;,$P(GMPL1,U,13):"H^Head/Neck Cancer",$P(GMPL1,U,16):"M^Mil Sexual Trauma",$P(GMPL1,U,17):"C^Combat Vet",$P(GMPL1,U,18):"S^SHAD",1:"^")
46 . S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"GMP PATIENT ACTIVE PROBLEMS",CNT)=PROB
47 S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"GMP PATIENT ACTIVE PROBLEMS",0)=CNT
48 Q
49 ;
50SELECT ; Select Common Problems
51 ; Sets Global Array:
52 ; ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS")
53 ; Piece 1: Pointer to Clinical Lexicon
54 ; 2: Problem Text
55 ; 3: ICD Code (null if unknown)
56 ;
57 N X,Y,DIC,PROB D CONFIG^LEXSET("ICD","ICD")
58 K ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS")
59 S DIC("A")="Select PROBLEM: ",DIC(0)="AEQM",DIC="^LEX(757.01,"
60 D ^DIC Q:+Y<0 S PROB=Y I +Y'>1 S PROB=+Y_U_X
61 S PROB=PROB_U_$G(Y(1))
62 S ^TMP("IB",$J,"INTERFACES","GMP SELECT CLINIC COMMON PROBLEMS")=PROB
63 Q
64 ;
65DSELECT ; List of Active Problems for DFN
66 ; Sets Global Array"
67 ; ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",#) =
68 ;
69 ; Piece 1: Problem IEN
70 ; 2: Problem Text
71 ; 3: ICD code
72 ; 4: Date of Onset 00/00/00 format
73 ; 5: SC/NSC/"" serv-conn/not sc/unknown
74 ; 6: Y/N/"" serv-conn/not sc/unknown
75 ; 7: A/I/E/H/M/C/S/"" If problem is flagged as:
76 ; A - Agent Orange
77 ; I - Ionizing Radiation
78 ; E - Environmental Contaminants
79 ; H - Head/Neck Cancer
80 ; M - Mil Sexual Trauma
81 ; C - Combat Vet
82 ; S - SHAD
83 ; - None
84 ; 8: Special Exposure Full text of piece 6
85 ;
86 N IFN,PROB,CNT,GMPL0,GMPL1,SC,NUM,GMPLIST,GMPARAM,GMPLVIEW,GMPTOTAL,GMPDFN,NODE
87 Q:$G(DFN)'>0 S GMPDFN=DFN,CNT=0,NODE=$G(^GMPL(125.99,1,0))
88 S GMPARAM("VER")=$P(NODE,U,2),GMPARAM("REV")=$P(NODE,U,5)="R",GMPARAM("QUIET")=1
89 S GMPLVIEW("ACT")="A",GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")=""
90 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)
91 F NUM=0:0 S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D
92 . S IFN=GMPLIST(NUM) Q:IFN'>0
93 . S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1))
94 . S PROB=$$PROBTEXT^GMPLX(IFN),CNT=CNT+1
95 . I GMPARAM("VER"),$P(GMPL1,U,2)="T" S PROB="$"_PROB
96 . S PROB=IFN_U_PROB
97 . S PROB=PROB_U_$P($G(^ICD9(+$P(GMPL0,U),0)),U)
98 . S PROB=PROB_U_$$EXTDT^GMPLX($P(GMPL0,U,13)),SC=$P(GMPL1,U,10)
99 . S PROB=PROB_U_$S(+SC:"SC^Y",SC=0:"NSC^N",1:"^")
100 . S PROB=PROB_U_$$GMPL1
101 . ;S PROB=PROB_U_$S($P(GMPL1,U,11):"A^Agent Orange",$P(GMPL1,U,12):"I^Radiation",$P(GMPL1,U,13):"E^Contaminants",$P(GMPL1,U,13):"H^Head/Neck Cancer"
102 . ;,$P(GMPL1,U,16):"M^Mil Sexual Trauma",$P(GMPL1,U,17):"C^Combat Vet",$P(GMPL1,U,18):"S^SHAD",1:"^")
103 . S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",CNT)=PROB
104 S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",0)=CNT
105 Q
106 ;
107GMPL1() ;Determine Treatment Factor, if any
108 N NXTTF,TXFACTOR
109 S TXFACTOR="^"
110 F NXTTF=11,12,13,15,16,17,18 I $P(GMPL1,U,NXTTF) S TXFACTOR=$P("A^Agent Orange;I^Ionizing Radiation;E^Env. Contaminants;;H^Head/Neck Cancer;M^Mil Sexual Trauma;C^Combat Vet;S^SHAD",";",NXTTF-10) Q
111 Q TXFACTOR
Note: See TracBrowser for help on using the repository browser.