source: WorldVistAEHR/trunk/r/NETWORK_HEALTH_EXCHANGE-AFJX/AFJXMABX.m@ 619

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1AFJXMABX ;FO-OAKLAND/GMB-PRINT BY SECTION NETWORK HEALTH EX's ;03/17/2003 07:45
2 ;;5.1;Network Health Exchange;**1,2,10,11,15,34,35**;Jan 23, 1996
3 ; Totally rewritten 3/2003. (Previously FJ/CWS.)
4 ; Called from ^AFJXWCPM
5ENTER ;
6 N AXNHEDUZ,AXABORT
7 S AXABORT=0
8 S AXNHEDUZ=$$FIND1^DIC(200,"","X","NETWORK,HEALTH EXCHANGE","B")
9 F D Q:AXABORT
10 . N DIR,X,Y,AXLIST,AXCNT
11 . W @IOF
12 . S DIR(0)="SO^Y:Your Own;A:All"
13 . S DIR("A")="Select the requests to list"
14 . S DIR("B")="Your Own"
15 . D ^DIR I $D(DIRUT) S AXABORT=1 Q
16 . D LIST(AXNHEDUZ,Y,.AXLIST,.AXCNT) Q:'AXCNT
17 . D CHOOSE(.AXLIST,AXCNT)
18 Q
19LIST(AXNHEDUZ,AXWHICH,AXLIST,AXCNT) ;
20 N AXMZ,AXREC,AXSUBJ,AXABORT,AXLEN,AXDATE
21 S (AXCNT,AXMZ,AXABORT)=0
22 S AXLEN("#")=$L($$BMSGCT^XMXUTIL(AXNHEDUZ,1))
23 S AXLEN("S")=79-14-AXLEN("#")-2-2+10
24 D LHDR(AXWHICH,.AXLEN)
25 F S AXMZ=$O(^XMB(3.7,AXNHEDUZ,2,1,1,AXMZ)) Q:'AXMZ D Q:AXABORT
26 . S AXREC=$G(^XMB(3.9,AXMZ,0))
27 . S AXSUBJ=$P(AXREC,U,1) Q:$E(AXSUBJ,19,19)'?1A!(AXSUBJ'["<")
28 . I AXWHICH="Y",$P($G(^XMB(3.9,AXMZ,2,1,0)),U,2)'=DUZ Q
29 . I $Y+5>IOSL D Q:AXABORT
30 . . I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.AXABORT) Q:AXABORT
31 . . D LHDR(AXWHICH,.AXLEN)
32 . S AXDATE=$$DATE^XMXUTIL2(AXREC)
33 . S AXCNT=AXCNT+1,AXLIST(AXCNT)=AXMZ
34 . W !,$J(AXCNT,AXLEN("#"))," ",AXDATE," ",$E(AXSUBJ,11,AXLEN("S"))
35 Q
36LHDR(AXWHICH,AXLEN) ;
37 W @IOF,$S(AXWHICH="Y":"Your",1:"All")," NHE Results"
38 W !," #",?AXLEN("#")+2,"Date Sent Subject"
39 W !,$$REPEAT^XLFSTR("=",79)
40 Q
41CHOOSE(AXLIST,AXCNT) ;
42 N DIR,X,Y,AXMZ,DIC,D,AXCOMP,AXABORT
43 S AXABORT=0
44 W !
45 S DIR(0)="NO^1:"_AXCNT
46 S DIR("A")="Select the report you'd like to print"
47 D ^DIR I $D(DIRUT) S AXABORT=1 Q
48 S AXMZ=AXLIST(Y)
49 F D Q:AXABORT
50 . K DIC,X,Y,D
51 . W !
52 . S DIC("A")="Select Component: "
53 . S DIC(0)="AEQZ",D="C" ; Lookup using only the C xref (upper-case)
54 . S DIC="^AFJ(537015,"
55 . D IX^DIC I Y<0 S AXABORT=1 Q
56 . S AXCOMP=Y(0,0)
57 . N AXSAVE,I,ZTSK
58 . W !
59 . F I="AXCOMP","AXMZ" S AXSAVE(I)=""
60 . D EN^XUTMDEVQ("PRINT^AFJXMABX","AFJX Print Completed NHE Results by Component",.AXSAVE,,1)
61 . I $D(ZTSK) W !,"Print queued. Task number: ",ZTSK
62 Q
63PRINT ; We assume that there may be more than 1 of the same component,
64 ; and that they are not necessarily consecutive.
65 N AXI,AXTXT,AXPAGE,AXABORT,AXFOUND,AXDASH
66 S (AXI,AXPAGE,AXABORT)=0,AXI=3,AXFOUND=0,AXDASH=$$REPEAT^XLFSTR("-",56)
67 D PHDR(AXMZ,.AXPAGE) W !
68 F S AXI=$O(^XMB(3.9,AXMZ,2,AXI)) Q:'AXI S AXTXT=$G(^(AXI,0)) D Q:AXABORT
69 . Q:AXTXT'[AXCOMP Q:$E(AXTXT,71,78)'["------"
70 . S AXFOUND=1
71 . F D Q:'AXI!AXABORT I $E(AXTXT,71,78)["------",AXTXT'[AXCOMP,AXTXT'[AXDASH Q
72 . . I $Y+3+($E(IOST,1,2)="C-")>IOSL D Q:AXABORT
73 . . . I $E(IOST,1,2)="C-" W ! D PAGE^XMXUTIL(.AXABORT) Q:AXABORT
74 . . . D PHDR(AXMZ,.AXPAGE) W !
75 . . W !,AXTXT
76 . . S AXI=$O(^XMB(3.9,AXMZ,2,AXI)),AXTXT=$G(^(+AXI,0))
77 I 'AXFOUND W !,"Component '",AXCOMP,"' is not in this request."
78 Q
79 ; We assume that there may be more than 1 of the same component,
80 ; and if so, that they are consecutive.
81 ;N AXI,AXTXT,AXPAGE,AXABORT
82 ;S (AXI,AXPAGE,AXABORT)=0,AXI=3
83 ;D PHDR(AXMZ,.AXPAGE) W !
84 ;F S AXI=$O(^XMB(3.9,AXMZ,2,AXI)) Q:'AXI S AXTXT=$G(^(AXI,0)) I AXTXT[AXCOMP,$E(AXTXT,71,78)["------" Q
85 ;I 'AXI W !,"Component '",AXCOMP,"' is not in this request." Q
86 ;W !,AXTXT
87 ;F S AXI=$O(^XMB(3.9,AXMZ,2,AXI)) Q:'AXI S AXTXT=$G(^(AXI,0)) Q:AXTXT?10."-"1" "1.5E1" - ".E1" "10."-"&(AXTXT'[AXCOMP) D Q:AXABORT
88 ;. I $Y+3+($E(IOST,1,2)="C-")>IOSL D Q:AXABORT
89 ;. . I $E(IOST,1,2)="C-" W ! D PAGE^XMXUTIL(.AXABORT) Q:AXABORT
90 ;. . D PHDR(AXMZ,.AXPAGE) W !
91 ;. W !,AXTXT
92 ;Q
93PHDR(AXMZ,AXPAGE) ;
94 N AXI
95 S AXPAGE=AXPAGE+1
96 I $E(IOST,1,2)="C-"!$D(AXPAGE(0)) W @IOF
97 E D ; Don't eject when printing first page to printer.
98 . W $C(13)
99 . S AXPAGE(0)=""
100 W "NHE Results for ",$$NAME^XMXUTIL(DUZ),?70,$J("PAGE "_AXPAGE,9)
101 F AXI=2,3 I $G(^XMB(3.9,AXMZ,2,AXI,0))'="" W !,^(0)
102 W !,$$REPEAT^XLFSTR("=",79)
103 Q
Note: See TracBrowser for help on using the repository browser.