AFJXMABX ;FO-OAKLAND/GMB-PRINT BY SECTION NETWORK HEALTH EX's ;03/17/2003 07:45
;;5.1;Network Health Exchange;**1,2,10,11,15,34,35**;Jan 23, 1996
; Totally rewritten 3/2003. (Previously FJ/CWS.)
; Called from ^AFJXWCPM
ENTER ;
N AXNHEDUZ,AXABORT
S AXABORT=0
S AXNHEDUZ=$$FIND1^DIC(200,"","X","NETWORK,HEALTH EXCHANGE","B")
F D Q:AXABORT
. N DIR,X,Y,AXLIST,AXCNT
. W @IOF
. S DIR(0)="SO^Y:Your Own;A:All"
. S DIR("A")="Select the requests to list"
. S DIR("B")="Your Own"
. D ^DIR I $D(DIRUT) S AXABORT=1 Q
. D LIST(AXNHEDUZ,Y,.AXLIST,.AXCNT) Q:'AXCNT
. D CHOOSE(.AXLIST,AXCNT)
Q
LIST(AXNHEDUZ,AXWHICH,AXLIST,AXCNT) ;
N AXMZ,AXREC,AXSUBJ,AXABORT,AXLEN,AXDATE
S (AXCNT,AXMZ,AXABORT)=0
S AXLEN("#")=$L($$BMSGCT^XMXUTIL(AXNHEDUZ,1))
S AXLEN("S")=79-14-AXLEN("#")-2-2+10
D LHDR(AXWHICH,.AXLEN)
F S AXMZ=$O(^XMB(3.7,AXNHEDUZ,2,1,1,AXMZ)) Q:'AXMZ D Q:AXABORT
. S AXREC=$G(^XMB(3.9,AXMZ,0))
. S AXSUBJ=$P(AXREC,U,1) Q:$E(AXSUBJ,19,19)'?1A!(AXSUBJ'["<")
. I AXWHICH="Y",$P($G(^XMB(3.9,AXMZ,2,1,0)),U,2)'=DUZ Q
. I $Y+5>IOSL D Q:AXABORT
. . I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.AXABORT) Q:AXABORT
. . D LHDR(AXWHICH,.AXLEN)
. S AXDATE=$$DATE^XMXUTIL2(AXREC)
. S AXCNT=AXCNT+1,AXLIST(AXCNT)=AXMZ
. W !,$J(AXCNT,AXLEN("#"))," ",AXDATE," ",$E(AXSUBJ,11,AXLEN("S"))
Q
LHDR(AXWHICH,AXLEN) ;
W @IOF,$S(AXWHICH="Y":"Your",1:"All")," NHE Results"
W !," #",?AXLEN("#")+2,"Date Sent Subject"
W !,$$REPEAT^XLFSTR("=",79)
Q
CHOOSE(AXLIST,AXCNT) ;
N DIR,X,Y,AXMZ,DIC,D,AXCOMP,AXABORT
S AXABORT=0
W !
S DIR(0)="NO^1:"_AXCNT
S DIR("A")="Select the report you'd like to print"
D ^DIR I $D(DIRUT) S AXABORT=1 Q
S AXMZ=AXLIST(Y)
F D Q:AXABORT
. K DIC,X,Y,D
. W !
. S DIC("A")="Select Component: "
. S DIC(0)="AEQZ",D="C" ; Lookup using only the C xref (upper-case)
. S DIC="^AFJ(537015,"
. D IX^DIC I Y<0 S AXABORT=1 Q
. S AXCOMP=Y(0,0)
. N AXSAVE,I,ZTSK
. W !
. F I="AXCOMP","AXMZ" S AXSAVE(I)=""
. D EN^XUTMDEVQ("PRINT^AFJXMABX","AFJX Print Completed NHE Results by Component",.AXSAVE,,1)
. I $D(ZTSK) W !,"Print queued. Task number: ",ZTSK
Q
PRINT ; We assume that there may be more than 1 of the same component,
; and that they are not necessarily consecutive.
N AXI,AXTXT,AXPAGE,AXABORT,AXFOUND,AXDASH
S (AXI,AXPAGE,AXABORT)=0,AXI=3,AXFOUND=0,AXDASH=$$REPEAT^XLFSTR("-",56)
D PHDR(AXMZ,.AXPAGE) W !
F S AXI=$O(^XMB(3.9,AXMZ,2,AXI)) Q:'AXI S AXTXT=$G(^(AXI,0)) D Q:AXABORT
. Q:AXTXT'[AXCOMP Q:$E(AXTXT,71,78)'["------"
. S AXFOUND=1
. F D Q:'AXI!AXABORT I $E(AXTXT,71,78)["------",AXTXT'[AXCOMP,AXTXT'[AXDASH Q
. . I $Y+3+($E(IOST,1,2)="C-")>IOSL D Q:AXABORT
. . . I $E(IOST,1,2)="C-" W ! D PAGE^XMXUTIL(.AXABORT) Q:AXABORT
. . . D PHDR(AXMZ,.AXPAGE) W !
. . W !,AXTXT
. . S AXI=$O(^XMB(3.9,AXMZ,2,AXI)),AXTXT=$G(^(+AXI,0))
I 'AXFOUND W !,"Component '",AXCOMP,"' is not in this request."
Q
; We assume that there may be more than 1 of the same component,
; and if so, that they are consecutive.
;N AXI,AXTXT,AXPAGE,AXABORT
;S (AXI,AXPAGE,AXABORT)=0,AXI=3
;D PHDR(AXMZ,.AXPAGE) W !
;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
;I 'AXI W !,"Component '",AXCOMP,"' is not in this request." Q
;W !,AXTXT
;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
;. I $Y+3+($E(IOST,1,2)="C-")>IOSL D Q:AXABORT
;. . I $E(IOST,1,2)="C-" W ! D PAGE^XMXUTIL(.AXABORT) Q:AXABORT
;. . D PHDR(AXMZ,.AXPAGE) W !
;. W !,AXTXT
;Q
PHDR(AXMZ,AXPAGE) ;
N AXI
S AXPAGE=AXPAGE+1
I $E(IOST,1,2)="C-"!$D(AXPAGE(0)) W @IOF
E D ; Don't eject when printing first page to printer.
. W $C(13)
. S AXPAGE(0)=""
W "NHE Results for ",$$NAME^XMXUTIL(DUZ),?70,$J("PAGE "_AXPAGE,9)
F AXI=2,3 I $G(^XMB(3.9,AXMZ,2,AXI,0))'="" W !,^(0)
W !,$$REPEAT^XLFSTR("=",79)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HAFJXMABX 3973 printed Nov 22, 2024@17:27:49 Page 2
AFJXMABX ;FO-OAKLAND/GMB-PRINT BY SECTION NETWORK HEALTH EX's ;03/17/2003 07:45
+1 ;;5.1;Network Health Exchange;**1,2,10,11,15,34,35**;Jan 23, 1996
+2 ; Totally rewritten 3/2003. (Previously FJ/CWS.)
+3 ; Called from ^AFJXWCPM
ENTER ;
+1 NEW AXNHEDUZ,AXABORT
+2 SET AXABORT=0
+3 SET AXNHEDUZ=$$FIND1^DIC(200,"","X","NETWORK,HEALTH EXCHANGE","B")
+4 FOR
Begin DoDot:1
+5 NEW DIR,X,Y,AXLIST,AXCNT
+6 WRITE @IOF
+7 SET DIR(0)="SO^Y:Your Own;A:All"
+8 SET DIR("A")="Select the requests to list"
+9 SET DIR("B")="Your Own"
+10 DO ^DIR
IF $DATA(DIRUT)
SET AXABORT=1
QUIT
+11 DO LIST(AXNHEDUZ,Y,.AXLIST,.AXCNT)
if 'AXCNT
QUIT
+12 DO CHOOSE(.AXLIST,AXCNT)
End DoDot:1
if AXABORT
QUIT
+13 QUIT
LIST(AXNHEDUZ,AXWHICH,AXLIST,AXCNT) ;
+1 NEW AXMZ,AXREC,AXSUBJ,AXABORT,AXLEN,AXDATE
+2 SET (AXCNT,AXMZ,AXABORT)=0
+3 SET AXLEN("#")=$LENGTH($$BMSGCT^XMXUTIL(AXNHEDUZ,1))
+4 SET AXLEN("S")=79-14-AXLEN("#")-2-2+10
+5 DO LHDR(AXWHICH,.AXLEN)
+6 FOR
SET AXMZ=$ORDER(^XMB(3.7,AXNHEDUZ,2,1,1,AXMZ))
if 'AXMZ
QUIT
Begin DoDot:1
+7 SET AXREC=$GET(^XMB(3.9,AXMZ,0))
+8 SET AXSUBJ=$PIECE(AXREC,U,1)
if $EXTRACT(AXSUBJ,19,19)'?1A!(AXSUBJ'["<")
QUIT
+9 IF AXWHICH="Y"
IF $PIECE($GET(^XMB(3.9,AXMZ,2,1,0)),U,2)'=DUZ
QUIT
+10 IF $Y+5>IOSL
Begin DoDot:2
+11 IF $EXTRACT(IOST,1,2)="C-"
DO PAGE^XMXUTIL(.AXABORT)
if AXABORT
QUIT
+12 DO LHDR(AXWHICH,.AXLEN)
End DoDot:2
if AXABORT
QUIT
+13 SET AXDATE=$$DATE^XMXUTIL2(AXREC)
+14 SET AXCNT=AXCNT+1
SET AXLIST(AXCNT)=AXMZ
+15 WRITE !,$JUSTIFY(AXCNT,AXLEN("#"))," ",AXDATE," ",$EXTRACT(AXSUBJ,11,AXLEN("S"))
End DoDot:1
if AXABORT
QUIT
+16 QUIT
LHDR(AXWHICH,AXLEN) ;
+1 WRITE @IOF,$SELECT(AXWHICH="Y":"Your",1:"All")," NHE Results"
+2 WRITE !," #",?AXLEN("#")+2,"Date Sent Subject"
+3 WRITE !,$$REPEAT^XLFSTR("=",79)
+4 QUIT
CHOOSE(AXLIST,AXCNT) ;
+1 NEW DIR,X,Y,AXMZ,DIC,D,AXCOMP,AXABORT
+2 SET AXABORT=0
+3 WRITE !
+4 SET DIR(0)="NO^1:"_AXCNT
+5 SET DIR("A")="Select the report you'd like to print"
+6 DO ^DIR
IF $DATA(DIRUT)
SET AXABORT=1
QUIT
+7 SET AXMZ=AXLIST(Y)
+8 FOR
Begin DoDot:1
+9 KILL DIC,X,Y,D
+10 WRITE !
+11 SET DIC("A")="Select Component: "
+12 ; Lookup using only the C xref (upper-case)
SET DIC(0)="AEQZ"
SET D="C"
+13 SET DIC="^AFJ(537015,"
+14 DO IX^DIC
IF Y<0
SET AXABORT=1
QUIT
+15 SET AXCOMP=Y(0,0)
+16 NEW AXSAVE,I,ZTSK
+17 WRITE !
+18 FOR I="AXCOMP","AXMZ"
SET AXSAVE(I)=""
+19 DO EN^XUTMDEVQ("PRINT^AFJXMABX","AFJX Print Completed NHE Results by Component",.AXSAVE,,1)
+20 IF $DATA(ZTSK)
WRITE !,"Print queued. Task number: ",ZTSK
End DoDot:1
if AXABORT
QUIT
+21 QUIT
PRINT ; We assume that there may be more than 1 of the same component,
+1 ; and that they are not necessarily consecutive.
+2 NEW AXI,AXTXT,AXPAGE,AXABORT,AXFOUND,AXDASH
+3 SET (AXI,AXPAGE,AXABORT)=0
SET AXI=3
SET AXFOUND=0
SET AXDASH=$$REPEAT^XLFSTR("-",56)
+4 DO PHDR(AXMZ,.AXPAGE)
WRITE !
+5 FOR
SET AXI=$ORDER(^XMB(3.9,AXMZ,2,AXI))
if 'AXI
QUIT
SET AXTXT=$GET(^(AXI,0))
Begin DoDot:1
+6 if AXTXT'[AXCOMP
QUIT
if $EXTRACT(AXTXT,71,78)'["------"
QUIT
+7 SET AXFOUND=1
+8 FOR
Begin DoDot:2
+9 IF $Y+3+($EXTRACT(IOST,1,2)="C-")>IOSL
Begin DoDot:3
+10 IF $EXTRACT(IOST,1,2)="C-"
WRITE !
DO PAGE^XMXUTIL(.AXABORT)
if AXABORT
QUIT
+11 DO PHDR(AXMZ,.AXPAGE)
WRITE !
End DoDot:3
if AXABORT
QUIT
+12 WRITE !,AXTXT
+13 SET AXI=$ORDER(^XMB(3.9,AXMZ,2,AXI))
SET AXTXT=$GET(^(+AXI,0))
End DoDot:2
if 'AXI!AXABORT
QUIT
IF $EXTRACT(AXTXT,71,78)["------"
IF AXTXT'[AXCOMP
IF AXTXT'[AXDASH
QUIT
End DoDot:1
if AXABORT
QUIT
+14 IF 'AXFOUND
WRITE !,"Component '",AXCOMP,"' is not in this request."
+15 QUIT
+16 ; We assume that there may be more than 1 of the same component,
+17 ; and if so, that they are consecutive.
+18 ;N AXI,AXTXT,AXPAGE,AXABORT
+19 ;S (AXI,AXPAGE,AXABORT)=0,AXI=3
+20 ;D PHDR(AXMZ,.AXPAGE) W !
+21 ;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
+22 ;I 'AXI W !,"Component '",AXCOMP,"' is not in this request." Q
+23 ;W !,AXTXT
+24 ;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
+25 ;. I $Y+3+($E(IOST,1,2)="C-")>IOSL D Q:AXABORT
+26 ;. . I $E(IOST,1,2)="C-" W ! D PAGE^XMXUTIL(.AXABORT) Q:AXABORT
+27 ;. . D PHDR(AXMZ,.AXPAGE) W !
+28 ;. W !,AXTXT
+29 ;Q
PHDR(AXMZ,AXPAGE) ;
+1 NEW AXI
+2 SET AXPAGE=AXPAGE+1
+3 IF $EXTRACT(IOST,1,2)="C-"!$DATA(AXPAGE(0))
WRITE @IOF
+4 ; Don't eject when printing first page to printer.
IF '$TEST
Begin DoDot:1
+5 WRITE $CHAR(13)
+6 SET AXPAGE(0)=""
End DoDot:1
+7 WRITE "NHE Results for ",$$NAME^XMXUTIL(DUZ),?70,$JUSTIFY("PAGE "_AXPAGE,9)
+8 FOR AXI=2,3
IF $GET(^XMB(3.9,AXMZ,2,AXI,0))'=""
WRITE !,^(0)
+9 WRITE !,$$REPEAT^XLFSTR("=",79)
+10 QUIT
