source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMRPCC.m@ 794

Last change on this file since 794 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1PXRMRPCC ;SLC/PJH - PXRM REMINDER DIALOG ;11/26/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 ;
4ACTIVE(ORY,ORREM) ;Check if active dialog exist for reminders
5 ;
6 ; input parameter ORREM is array of reminder ien [.01#811.9]
7 N DDIS,DIEN,OCNT,RIEN,RSTA
8 S OCNT=0,RIEN=0
9 ;Get reminder ien from array
10 F S RIEN=$O(ORREM(RIEN)) Q:'RIEN D
11 .;Dialog ien for reminder
12 .S DIEN=$P($G(^PXD(811.9,RIEN,51)),U),RSTA=0
13 .;Dialog status
14 .I DIEN S DDIS=$P($G(^PXRMD(801.41,DIEN,0)),U,3)
15 .;If dialog and dialog not disabled
16 .I DIEN,DDIS="" S RSTA=1
17 .;Return reminder and if active dialog exists
18 .S OCNT=OCNT+1,ORY(OCNT)=RIEN_U_RSTA
19 Q
20 ;
21 ;
22DIALOG(ORY,ORREM,DFN) ;Load reminder dialog associated with the reminder
23 ;
24 ; input parameter ORREM - reminder ien [.01,#811.9]
25 ;
26 S RIEN=ORREM
27 N DATA,DIEN
28 S DIEN=$G(^PXD(811.9,ORREM,51))
29 ;
30 ;Quit if no dialog for this reminder
31 I 'DIEN S ORY(1)="-1^no dialog for this reminder" Q
32 ;
33 ;Check if a reminder dialog and enabled
34 S DATA=$G(^PXRMD(801.41,DIEN,0))
35 ;
36 I $P(DATA,U,4)'="R" S ORY(1)="-1^reminder dialog invalid" Q
37 ;
38 I $P(DATA,U,3) S ORY(1)="-1^reminder dialog disabled" Q
39 ;
40 ;Load dialog lines into local array
41 S ORY(0)=0_U_+$P($G(^PXRMD(801.41,DIEN,0)),U,17)
42 D LOAD^PXRMDLL(DIEN,$G(DFN))
43 Q
44 ;
45HDR(ORY,ORLOC) ;Progress Note Header by location/service/user
46 N ORSRV,PASS
47 ;S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
48 S ORSRV=$$GET1^DIQ(200,DUZ,29,"I")
49 S PASS=DUZ_";VA(200,"
50 I +$G(ORLOC) S PASS=PASS_"^LOC.`"_ORLOC
51 I ORSRV>0 S PASS=PASS_"^SRV.`"_+$G(ORSRV)
52 S ORY=$$GET^XPAR(PASS_"^DIV^SYS^PKG","PXRM PROGRESS NOTE HEADERS",1,"Q")
53 Q
54 ;
55PROMPT(ORY,ORDLG,ORDCUR,ORFTYP) ;Load additional prompts for a dialog element
56 ;
57 ; input parameters
58 ;
59 ; ORDLG - dialog element ien [.01,#801.41]
60 ; ORDCUR - 0 = current, 1 = Historical for taxonomies only
61 ; ORFTYP - finding type (CPT/POV) for taxonomies only
62 ;
63 ; These fields can be found in the output array of DIALOG^PXRMRPCC
64 ;
65 D LOAD^PXRMDLLA(ORDLG,ORDCUR,$G(ORFTYP))
66 Q
67 ;
68RES(ORY,ORREM) ; Reminder Resources/Inquiry
69 ;
70 ; input parameter ORREM - reminder ien [.01,#811.9]
71 ;
72 D REMVAR^PXRMINQ(.ORY,ORREM)
73 Q
74 ;
75MH(ORY,OTEST) ; Mental Health dialog
76 ;
77 ; Input mental health instrument NAME
78 ;
79 K ^TMP($J,"YSQU")
80 N ARRAY,CNT,CNT1,FNODE,FSUB,IC,NODE,OCNT,SUB,YS
81 ;DBIA #5056
82 S YS("CODE")=OTEST D SHOWALL^YTQPXRM5(.ARRAY,.YS)
83 S OCNT=0,CNT=0
84 S SUB="ARRAY",OCNT=0
85 F S SUB=$Q(@SUB) Q:SUB="" D
86 .S FSUB=$P($P(SUB,"(",2),")"),FNODE=""
87 .F IC=1:1 S NODE=$P(FSUB,",",IC) Q:NODE="" D
88 ..I $E(NODE)="""" S NODE=$P(NODE,"""",2)
89 ..S $P(FNODE,";",IC)=NODE
90 .Q:FNODE=""
91 .S OCNT=OCNT+1,ORY(OCNT)=FNODE_U_@SUB
92 Q
93 ;
94MHR(ORY,RESULT,ORES) ; Mental Health score and P/N text
95 ;
96 ; Input MH result IEN and mental health instrument response
97 ;
98 D START^PXRMDLR(.ORY,RESULT,.ORES)
99 ;
100 Q
101 ;
102MHS(ORY,YS) ; Mental Health save response
103 ;
104 ; Input mental health instrument response
105 N ANS,ARRAY,X
106 S ANS=$G(YS("R1")) K YS("R1")
107 S YS("ADATE")=YS("ADATE")_"."_$P($$NOW^XLFDT,".",2)
108 F X=1:1:$L(ANS) I $E(ANS,X)'="X" S YS(X)=X_U_$E(ANS,X)
109 ;DBIA #4463
110 D SAVECR^YTQPXRM4(.ARRAY,.YS)
111 Q
112 ;
113MST(ORY,DFN,DGMSTDT,DGMSTSC,DGMSTPR,FTYP,FIEN,RESULT) ; File MST status
114 ;This is obsolete and can be removed when the GUI is changed not
115 ;to use it.
116 Q
117 ;
118WH(ORY,RESULT) ;
119 N CNT,CNT1,CNT2,NODE,PIECNT,PUR,TYPE,TYP1,WVIEN,WVRESULT,WVNOT,WVPURIEN
120 N PRINT
121 K ^TMP("WV RPT",$J)
122 I '$D(RESULT) Q
123 S (CNT2,WVPURIEN,PUR)=0
124 S CNT=0 F S CNT=$O(RESULT(CNT)) Q:CNT="" D
125 . I $P($G(RESULT(CNT)),U)["WHIEN" D
126 . . S CNT2=CNT2+1
127 . . S WVIEN=$P($P($G(RESULT(CNT)),U),":",2),WVRESULT(CNT2)=$G(WVIEN)
128 . . S WVRESULT(CNT2)=WVRESULT(CNT2)_U_$P($P($G(RESULT(CNT)),U,3),":",2)
129 . I $P($G(RESULT(CNT)),U)["WHPur" D
130 . . S NODE=$G(RESULT(CNT)),PUR=$P($P($G(NODE),U),":",2)
131 . . S CNT1=1,TYPE=$P($G(NODE),U,2)
132 . . I TYPE'[":" D
133 ...S WVNOT(PUR,CNT1)=$P($G(NODE),U,5)_U_$P($G(NODE),U,2)_U_$P($G(NODE),U,3)_U_$P($P($G(NODE),U,4),":",2)
134 ..I TYPE[":" D
135 ...S PIECNT=0
136 ...F X=1:1:$L(TYPE) I $E(TYPE,X)=":" S PIECNT=PIECNT+1 I PIECNT>0 D
137 ....S PRINT=""
138 ....S TYP1=$P($G(TYPE),":",PIECNT)
139 ....I TYP1="L" S PRINT=$P($G(NODE),U,3)
140 ....S WVNOT(PUR,CNT1)=$P($G(NODE),U,5)_U_$G(TYP1)_U_$G(PRINT)_U_$P($P($G(NODE),U,4),":",2),CNT1=CNT1+1
141 ...S PIECNT=PIECNT+1
142 ...S PRINT=""
143 ...S TYP1=$P($G(TYPE),":",PIECNT)
144 ...I TYP1="L" S PRINT=$P($G(NODE),U,3)
145 ...S WVNOT(PUR,CNT1)=$P($G(NODE),U,5)_U_$G(TYP1)_U_$G(PRINT)_U_$P($P($G(NODE),U,4),":",2)
146 K WHMUFIND,WHFIND,WHNAME
147 ;DBIA #4104
148 D NEW^WVRPCNO(.WVRESULT,.WVNOT)
149 Q
150 ;
Note: See TracBrowser for help on using the repository browser.