Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AFJXMABX

AFJXMABX.m

Go to the documentation of this file. 
  1. 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
  1.  ; Totally rewritten 3/2003.  (Previously FJ/CWS.)
  1.  ; Called from ^AFJXWCPM
  1. ENTER ;
  1.  N AXNHEDUZ,AXABORT
  1.  S AXABORT=0
  1.  S AXNHEDUZ=$$FIND1^DIC(200,"","X","NETWORK,HEALTH EXCHANGE","B")
  1.  F  D  Q:AXABORT
  1.  . N DIR,X,Y,AXLIST,AXCNT
  1.  . W @IOF
  1.  . S DIR(0)="SO^Y:Your Own;A:All"
  1.  . S DIR("A")="Select the requests to list"
  1.  . S DIR("B")="Your Own"
  1.  . D ^DIR I $D(DIRUT) S AXABORT=1 Q
  1.  . D LIST(AXNHEDUZ,Y,.AXLIST,.AXCNT) Q:'AXCNT
  1.  . D CHOOSE(.AXLIST,AXCNT)
  1.  Q
  1. LIST(AXNHEDUZ,AXWHICH,AXLIST,AXCNT) ;
  1.  N AXMZ,AXREC,AXSUBJ,AXABORT,AXLEN,AXDATE
  1.  S (AXCNT,AXMZ,AXABORT)=0
  1.  S AXLEN("#")=$L($$BMSGCT^XMXUTIL(AXNHEDUZ,1))
  1.  S AXLEN("S")=79-14-AXLEN("#")-2-2+10
  1.  D LHDR(AXWHICH,.AXLEN)
  1.  F  S AXMZ=$O(^XMB(3.7,AXNHEDUZ,2,1,1,AXMZ)) Q:'AXMZ  D  Q:AXABORT
  1.  . S AXREC=$G(^XMB(3.9,AXMZ,0))
  1.  . S AXSUBJ=$P(AXREC,U,1) Q:$E(AXSUBJ,19,19)'?1A!(AXSUBJ'["<")
  1.  . I AXWHICH="Y",$P($G(^XMB(3.9,AXMZ,2,1,0)),U,2)'=DUZ Q
  1.  . I $Y+5>IOSL D  Q:AXABORT
  1.  . . I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.AXABORT) Q:AXABORT
  1.  . . D LHDR(AXWHICH,.AXLEN)
  1.  . S AXDATE=$$DATE^XMXUTIL2(AXREC)
  1.  . S AXCNT=AXCNT+1,AXLIST(AXCNT)=AXMZ
  1.  . W !,$J(AXCNT,AXLEN("#")),"  ",AXDATE,"  ",$E(AXSUBJ,11,AXLEN("S"))
  1.  Q
  1. LHDR(AXWHICH,AXLEN) ;
  1.  W @IOF,$S(AXWHICH="Y":"Your",1:"All")," NHE Results"
  1.  W !," #",?AXLEN("#")+2,"Date Sent       Subject"
  1.  W !,$$REPEAT^XLFSTR("=",79)
  1.  Q
  1. CHOOSE(AXLIST,AXCNT) ;
  1.  N DIR,X,Y,AXMZ,DIC,D,AXCOMP,AXABORT
  1.  S AXABORT=0
  1.  W !
  1.  S DIR(0)="NO^1:"_AXCNT
  1.  S DIR("A")="Select the report you'd like to print"
  1.  D ^DIR I $D(DIRUT) S AXABORT=1 Q
  1.  S AXMZ=AXLIST(Y)
  1.  F  D  Q:AXABORT
  1.  . K DIC,X,Y,D
  1.  . W !
  1.  . S DIC("A")="Select Component: "
  1.  . S DIC(0)="AEQZ",D="C" ; Lookup using only the C xref (upper-case)
  1.  . S DIC="^AFJ(537015,"
  1.  . D IX^DIC I Y<0 S AXABORT=1 Q
  1.  . S AXCOMP=Y(0,0)
  1.  . N AXSAVE,I,ZTSK
  1.  . W !
  1.  . F I="AXCOMP","AXMZ" S AXSAVE(I)=""
  1.  . D EN^XUTMDEVQ("PRINT^AFJXMABX","AFJX Print Completed NHE Results by Component",.AXSAVE,,1)
  1.  . I $D(ZTSK) W !,"Print queued.  Task number: ",ZTSK
  1.  Q
  1. PRINT ; We assume that there may be more than 1 of the same component,
  1.  ; and that they are not necessarily consecutive.
  1.  N AXI,AXTXT,AXPAGE,AXABORT,AXFOUND,AXDASH
  1.  S (AXI,AXPAGE,AXABORT)=0,AXI=3,AXFOUND=0,AXDASH=$$REPEAT^XLFSTR("-",56)
  1.  D PHDR(AXMZ,.AXPAGE) W !
  1.  F  S AXI=$O(^XMB(3.9,AXMZ,2,AXI)) Q:'AXI  S AXTXT=$G(^(AXI,0)) D  Q:AXABORT
  1.  . Q:AXTXT'[AXCOMP  Q:$E(AXTXT,71,78)'["------"
  1.  . S AXFOUND=1
  1.  . F  D  Q:'AXI!AXABORT  I $E(AXTXT,71,78)["------",AXTXT'[AXCOMP,AXTXT'[AXDASH Q
  1.  . . I $Y+3+($E(IOST,1,2)="C-")>IOSL D  Q:AXABORT
  1.  . . . I $E(IOST,1,2)="C-" W ! D PAGE^XMXUTIL(.AXABORT) Q:AXABORT
  1.  . . . D PHDR(AXMZ,.AXPAGE) W !
  1.  . . W !,AXTXT
  1.  . . S AXI=$O(^XMB(3.9,AXMZ,2,AXI)),AXTXT=$G(^(+AXI,0))
  1.  I 'AXFOUND W !,"Component '",AXCOMP,"' is not in this request."
  1.  Q
  1.  ; We assume that there may be more than 1 of the same component,
  1.  ; and if so, that they are consecutive.
  1.  ;N AXI,AXTXT,AXPAGE,AXABORT
  1.  ;S (AXI,AXPAGE,AXABORT)=0,AXI=3
  1.  ;D PHDR(AXMZ,.AXPAGE) W !
  1.  ;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
  1.  ;I 'AXI W !,"Component '",AXCOMP,"' is not in this request." Q
  1.  ;W !,AXTXT
  1.  ;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
  1.  ;. I $Y+3+($E(IOST,1,2)="C-")>IOSL D  Q:AXABORT
  1.  ;. . I $E(IOST,1,2)="C-" W ! D PAGE^XMXUTIL(.AXABORT) Q:AXABORT
  1.  ;. . D PHDR(AXMZ,.AXPAGE) W !
  1.  ;. W !,AXTXT
  1.  ;Q
  1. PHDR(AXMZ,AXPAGE) ;
  1.  N AXI
  1.  S AXPAGE=AXPAGE+1
  1.  I $E(IOST,1,2)="C-"!$D(AXPAGE(0)) W @IOF
  1.  E  D  ; Don't eject when printing first page to printer.
  1.  . W $C(13)
  1.  . S AXPAGE(0)=""
  1.  W "NHE Results for ",$$NAME^XMXUTIL(DUZ),?70,$J("PAGE "_AXPAGE,9)
  1.  F AXI=2,3 I $G(^XMB(3.9,AXMZ,2,AXI,0))'="" W !,^(0)
  1.  W !,$$REPEAT^XLFSTR("=",79)
  1.  Q