source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXAP.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1PXRMXAP ; SLC/PJH - Reminder Reports APIs;07/29/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ; Called from PXRMSU
5 ;
6FACT ;Check PCMM Team ^SCTM(404.51 for facility ; DBIA #2795
7 S DIC("S")=DIC("S")_",$D(PXRMFACN(+$P(^(0),U,7)))"
8 Q
9 ;
10LOCN(ARRAY) ;Check for mixed inpatient/outpatient locations ; DBIA #10040
11 N IC,IEN,MIXED,TYPE
12 S IC=0,MIXED=0,TYPE=0
13 F S IC=$O(ARRAY(IC)) Q:IC="" D Q:MIXED
14 .S IEN=$P(ARRAY(IC),U,2) Q:IEN=""
15 .I TYPE=0,$D(^SC(IEN,42)) S TYPE="INPATIENT" Q
16 .I TYPE=0,'$D(^SC(IEN,42)) S TYPE="OUTPATIENT" Q
17 .I TYPE="INPATIENT",'$D(^SC(IEN,42)) S MIXED=1 Q
18 .I TYPE="OUTPATIENT",$D(^SC(IEN,42)) S MIXED=1 Q
19 Q MIXED
20 ;
21 ; Called from PXRMSEO
22 ;
23FAC(TIEN) ; Get Facility for the PCMM Team ; DBIA #2795
24 Q $P($G(^SCTM(404.51,TIEN,0)),U,7)
25 ;
26PCASSIGN(DFN) ; Assigned to Provider as Primary Care ; DBIA #1916
27 N PCVAR,PC S PC=0
28 S PCVAR=$$OUTPTPR^SDUTL3(DFN)
29 I PCVAR]"" S:$P(PCVAR,U)=PCM PC=1
30 Q PC
31 ;
32PTTM(TIEN,SCERR) ; Build list of Teams Patients ; DBIA #1916
33 Q $$PTTM^SCAPMC(TIEN,"SCDT","^TMP($J,""PCM"")",.SCERR)
34 ;
35PTPR(PIEN,PXRMREP) ; Build list of practitioners patients ; DBIA #1916
36 N SCERRD,OK
37 S OK=$$PTPR^SCAPMC(PIEN,"SCDT","","","^TMP($J,""PCM"")",.SCERRD)
38 ;
39 ; Determine Associated Clinic from Team Position/Team Position Assign
40 I PXRMREP="D" D
41 .N SUB,SCTP,SCTPA,DCLN
42 .S SUB=0
43 .F S SUB=$O(^TMP($J,"PCM",SUB)) Q:'SUB D
44 ..S SCTP=$P(^TMP($J,"PCM",SUB),U,3) Q:SCTP=""
45 ..S SCTPA=$P($G(^SCPT(404.43,SCTP,0)),U,2) Q:SCTPA="" ; DBIA #2811
46 ..S DCLN=$P($G(^SCTM(404.57,SCTPA,0)),U,9) ; DBIA #2810
47 ..S $P(^TMP($J,"PCM",SUB),U,7)=DCLN
48 Q
49 ;
50 ; Called from PXRMXD/PXRMYD
51 ;
52INP(INP,PXRMLOCN) ;
53 ;If selected locations check for wards ; DBIA #10040
54 N LOC,WARD
55 S LOC="",WARD=0
56 ; All locations must be wards for the prompt to display
57 F S LOC=$O(PXRMLOCN(LOC)) Q:LOC="" D Q:'WARD
58 .S WARD=0 I $D(^SC(LOC,42)) S WARD=1
59 Q WARD
60 ;
61 ; Called from PXRMXSEL/PXRMYSEL
62 ;
63FACL(LOCIEN) ; Get locations facility ; DBIA #2804
64 N DIV
65 I $P($G(^SC(LOCIEN,0)),U,4)'="" Q $P($G(^SC(LOCIEN,0)),U,4)
66 S DIV=$P($G(^SC(LOCIEN,0)),U,15) Q:DIV="" ""
67 Q $P($G(^DG(40.8,DIV,0)),U,7)
68 ;
69WARD(LOCIEN,ARRAY) ;Get list of patients if location is a ward ;DBIA #10035
70 N WARDIEN,WARDNAM,DFN
71 S WARDIEN=$G(^SC(LOCIEN,42)) Q:WARDIEN=""
72 S WARDNAM=$P($G(^DIC(42,WARDIEN,0)),U) Q:WARDNAM=""
73 S DFN=""
74 F S DFN=$O(^DPT("CN",WARDNAM,DFN)) Q:DFN="" S ARRAY(DFN)=""
75 Q
76 ;
77ADM(LOCIEN,ARRAY,BD,ED) ;Get list of admissions to ward ; DBIA #10040,1480
78 N WARDIEN,DA,DATA,DFN
79 S WARDIEN=$G(^SC(LOCIEN,42)) Q:WARDIEN=""
80 F S BD=$O(^DGPM("ATT1",BD)) Q:BD>ED Q:BD="" D
81 .S DA=""
82 .F S DA=$O(^DGPM("ATT1",BD,DA)) Q:DA="" D
83 ..S DATA=$G(^DGPM(DA,0)) Q:DATA=""
84 ..I $P(DATA,U,6)'=WARDIEN Q
85 ..S DFN=$P(DATA,U,3) Q:DFN=""
86 ..S ARRAY(DFN)=""
87 Q
88 ;
89LCHL(INP,ARRAY) ;Get list of all inpatient or outpatient locations ; DBIA #10040
90 N HLOCIEN,NAME,IC
91 S HLOCIEN=0,IC=0
92 F S HLOCIEN=$O(^SC(HLOCIEN)) Q:'HLOCIEN D
93 .;Outpatient report ignores wards - HA
94 .I INP=0,$D(^SC(HLOCIEN,42)) Q
95 .;Inpatient report includes only wards - HAI
96 .I INP=1,'$D(^SC(HLOCIEN,42)) Q
97 .S NAME=$P($G(^SC(HLOCIEN,0)),U) I NAME="" Q
98 .;Build array
99 .S IC=IC+1,PXRMLCHL(IC)=NAME_U_HLOCIEN,PXRMLOCN(HLOCIEN)=IC
100 Q
Note: See TracBrowser for help on using the repository browser.