source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBAB57.m@ 1354

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

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1DVBAB57 ;ALB/KLB - AMIE GUI PENDING 7131 REPORT ;09/7/00
2 ;;2.7;AMIE;**35,42**;Apr 10, 1995
3 ;
4STRT(MSG,SELDIV,DIV) ;
5 S RO="N"
6 S RONUM=0
7 S DIVNUM="",MSGCNT=1
8 K ^TMP($J)
9 I RO="Y",RONUM="" S MSG(1)="To sort by RO Number, please enter the RO Number."
10 I RO="Y",RONUM="" Q
11 I SELDIV="Y",DIV="" S MSG(1)="To sort by Division, please enter the Division."
12 I SELDIV="Y",DIV="" Q
13 I DIV'="" S DIVNUM=$O(^DG(40.8,"C",DIV,DIVNUM)),DIVNAM=$S($D(^DG(40.8,+DIVNUM,0)):$P(^(0),"^",1),1:"Unknown Division")
14SETUP D STM^DVBCUTL4
15 S FDT(0)=$$FMTE^XLFDT(DT,"5DZ"),(PG,DVBAQUIT)=0
16 S HEAD="PENDING REQUEST REPORT FOR "_$P(^DVB(396.1,1,0),U,1)
17 S HEAD2=$S(RO="Y":"FOR REGIONAL OFFICE "_RONUM,1:"ALL REGIONAL OFFICES")
18 S HEAD2=HEAD2_$S(SELDIV="Y":", FOR DIVISION "_DIVNAM,1:", ALL DIVISIONS")
19 S PROCDT="Processed on: "_FDT(0)
20 S QQ=1,NODTA=0
21 S ^TMP("CAPRI",MSGCNT)="Pending 7131 Report"_"^",MSGCNT=MSGCNT+1
22 S ^TMP("CAPRI",MSGCNT)=""_"^",MSGCNT=MSGCNT+1
23 S ^TMP("CAPRI",MSGCNT)=HEAD_"^",MSGCNT=MSGCNT+1
24 S ^TMP("CAPRI",MSGCNT)=HEAD2_"^",MSGCNT=MSGCNT+1
25 S ^TMP("CAPRI",MSGCNT)=PROCDT_"^",MSGCNT=MSGCNT+1
26 S ^TMP("CAPRI",MSGCNT)=""_"^",MSGCNT=MSGCNT+1
27DATA N REQDTE S REQDTE="",CNT=0
28 S:SELDIV="Y" ADIV=DIVNAM
29 F J=0:0 S REQDTE=$O(^DVB(396,"E",REQDTE)) Q:REQDTE="" F DA=0:0 S DA=$O(^DVB(396,"E",REQDTE,DA)) Q:DA="" I $D(^DVB(396,DA,1)),($P(^DVB(396,DA,1),U,12)="") D:SELDIV="N" ADIV D MAKUTL
30 S (ADIV,REQDTE)=""
31 F L=0:0 S REQDTE=$O(^TMP($J,REQDTE)) Q:REQDTE="" D LVL2LP
32 ;
33EXIT I NODTA=0 S MSG(1)="No pending requests found for parameters entered."
34 I NODTA>0 S MSG=$NA(^TMP("CAPRI"))
35 ;
36KILL S XRTN=$T(+0)
37 D SPM^DVBCUTL4
38 K ^TMP("DVBA","ADMIT",$J),^TMP($J),DVBAQUIT,SELDIV,DIVNUM,REQDTE,PROCDT,QQ,RO,RONUM,XRTN
39 K LPCNT1,PATDA,DIVNAM,XJ,XI,GDIVPTR,GDIVNUM,GINSTPT,GDIVNAM,GDIV,ADIV,CFLOC,DA,DIV,FDT,HEAD,HEAD2,J,L,MSGCNT,NODTA,PG
40 Q
41 ;
42LVL2LP ; ** 2nd level of the 2nd loop in the DATA tag - search ADIV **
43 F J=0:0 S ADIV=$O(^TMP($J,REQDTE,ADIV)) Q:ADIV="" D LPLVL3
44 Q
45 ;
46LPLVL3 ; ** 2nd level of the loop in the LVL2LP tag - search DA **
47 F DA=0:0 S DA=$O(^TMP($J,REQDTE,ADIV,DA)) Q:DA="" D PRINT^DVBAB67 S:DVBAQUIT=1 ADIV="ZZZZ",DA=999999999,REQDTE=9999999 S QQ=1
48 Q
49 ;
50MAKUTL ; ** Sort on Request Date to set up a temporary utility global **
51 S PATDA=$P(^DVB(396,DA,0),"^",1)
52 ;S REQDTE=$P(^DVB(396,DA,1),"^",1),PATDA=$P(^DVB(396,DA,0),"^",1)
53 S CFLOC=$$STATION^DVBAUTL1(PATDA)
54 S:CFLOC=-1 CFLOC=0
55 I SELDIV="Y"&(RO="Y") I CFLOC=RONUM D CHKDIV D:$D(DVBAFND) SETARY
56 I SELDIV="Y"&(RO="N") D CHKDIV D:$D(DVBAFND) SETARY
57 I SELDIV="N"&(RO="Y") I CFLOC=RONUM D SETARY
58 I SELDIV="N"&(RO="N") D SETARY
59 K DVBAFND
60 QUIT
61 ;
62SETARY ; ** Set temporary utility global **
63 S ^TMP($J,REQDTE,ADIV,DA)=""
64 QUIT
65 ;
66ADIV S ADIV=$S($D(^DVB(396,DA,2)):$P(^(2),U,9),1:"") S ADIV=$S($D(^DG(40.8,+ADIV,0)):$P(^(0),U,1),1:"Unknown Division")
67 Q
68 ;
69CHKDIV ;**Check for selected Div
70 N FLDVAR
71 I $D(^DVB(396,DA,6)) DO
72 .F FLDVAR=7,9,11,13,15,17,19,21,23,26,28 Q:$D(DVBAFND) DO
73 ..I ($P(^DVB(396,DA,6),U,FLDVAR)=DIVNUM) DO
74 ...I FLDVAR=7 S:$P(^DVB(396,DA,1),U,FLDVAR)="P" DVBAFND=""
75 ...I FLDVAR'=7 S:$P(^DVB(396,DA,0),U,FLDVAR)="P" DVBAFND=""
76 I $D(^DVB(396,DA,2)),('$D(DVBAFND)) DO ;**Check Routing Loc Division
77 .I $D(^DVB(396,DA,1)) DO
78 ..I $P(^DVB(396,DA,2),U,9)=DIVNUM,($P(^DVB(396,DA,1),U,12)="") DO
79 ...S DVBAFND=""
80 Q
Note: See TracBrowser for help on using the repository browser.