AFJXWCPM ;FO-OAKLAND/GMB-REQUEST PATIENT INFO MENU ;11/8/95
;;5.1;Network Health Exchange;**6,22,31,33,34**;Jan 23, 1996
; Totally rewritten 11/2001. (Previously FJ/CWS.)
; Entry point:
; EN - Invoked by option AFJXNHEX REQUEST
EN ;
I '$G(DUZ) W !!,"You must have a DUZ defined ........" H 3 W !! Q
Q:'$$NHEACTIV
D HOME^%ZIS ; Not sure this is needed, but I left it in, anyway.
N AXABORT
S AXABORT=0
F D Q:AXABORT
. N DIR,X,Y,DIRUT
. D HDR
. S DIR("A")=" Enter choice"
. S DIR(0)="SO^1:Brief (12 months) Medical Record Information"
. S DIR(0)=DIR(0)_";2:Total Medical Record Information"
. S DIR(0)=DIR(0)_";3:Brief (12 months) Pharmacy Information"
. S DIR(0)=DIR(0)_";4:Total Pharmacy Information"
. S DIR(0)=DIR(0)_";5:Print (Completed Requests Only)"
. S DIR(0)=DIR(0)_";6:Print By Type of Information (Completed Requests)"
. D ^DIR I $D(DIRUT) S AXABORT=1 Q
. D @Y
W @IOF
Q
1 ; Brief (12 months) Medical Record Information
D REQUEST^AFJXWCP1("PB")
Q
2 ; Total Medical Record Information
D REQUEST^AFJXWCP1("P")
Q
3 ; Brief (12 months) Pharmacy Information
D REQUEST^AFJXWCP1("RB")
Q
4 ; Total Pharmacy Information
D REQUEST^AFJXWCP1("R")
Q
5 ; Print (Completed Requests Only)
D ENTER^AFJXMBOX
Q
6 ; Print By Type of Information (Completed Requests)
D ENTER^AFJXMABX
Q
HDR ; Print page header
N AX1,AX2
W @IOF
S AX1="VistA Network Health Exchange Menu"
S AX2=$$NAME^XMXUTIL(DUZ)
W AX1,$J(AX2,74-$L(AX1)),!,$$REPEAT^XLFSTR("=",74)
Q
NHEACTIV() ; Is NHE user active?
N AXNHEDUZ,AXTXT,AXI
S AXI=0
S AXNHEDUZ=$$FIND1^DIC(200,"","X","NETWORK,HEALTH EXCHANGE")
I 'AXNHEDUZ D
. S AXI=AXI+1,AXTXT(AXI)="The NETWORK,HEALTH EXCHANGE user is not in the NEW PERSON file."
E I $P($G(^VA(200,AXNHEDUZ,0)),U,3)="" D
. S AXI=AXI+1,AXTXT(AXI)="The NETWORK,HEALTH EXCHANGE user does not have an access code."
I '$D(^XMB(3.7,+AXNHEDUZ,2)) D
. S AXI=AXI+1,AXTXT(AXI)="The NETWORK,HEALTH EXCHANGE user does not have a MAILBOX."
Q:'AXI 1
W $C(7),!
S AXI=0 F S AXI=$O(AXTXT(AXI)) Q:'AXI W !,AXTXT(AXI)
W !!,"Please inform IRM."
W !,"Until this is corrected, you will not be able to use this option."
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HAFJXWCPM 2217 printed Nov 22, 2024@17:28:04 Page 2
AFJXWCPM ;FO-OAKLAND/GMB-REQUEST PATIENT INFO MENU ;11/8/95
+1 ;;5.1;Network Health Exchange;**6,22,31,33,34**;Jan 23, 1996
+2 ; Totally rewritten 11/2001. (Previously FJ/CWS.)
+3 ; Entry point:
+4 ; EN - Invoked by option AFJXNHEX REQUEST
EN ;
+1 IF '$GET(DUZ)
WRITE !!,"You must have a DUZ defined ........"
HANG 3
WRITE !!
QUIT
+2 if '$$NHEACTIV
QUIT
+3 ; Not sure this is needed, but I left it in, anyway.
DO HOME^%ZIS
+4 NEW AXABORT
+5 SET AXABORT=0
+6 FOR
Begin DoDot:1
+7 NEW DIR,X,Y,DIRUT
+8 DO HDR
+9 SET DIR("A")=" Enter choice"
+10 SET DIR(0)="SO^1:Brief (12 months) Medical Record Information"
+11 SET DIR(0)=DIR(0)_";2:Total Medical Record Information"
+12 SET DIR(0)=DIR(0)_";3:Brief (12 months) Pharmacy Information"
+13 SET DIR(0)=DIR(0)_";4:Total Pharmacy Information"
+14 SET DIR(0)=DIR(0)_";5:Print (Completed Requests Only)"
+15 SET DIR(0)=DIR(0)_";6:Print By Type of Information (Completed Requests)"
+16 DO ^DIR
IF $DATA(DIRUT)
SET AXABORT=1
QUIT
+17 DO @Y
End DoDot:1
if AXABORT
QUIT
+18 WRITE @IOF
+19 QUIT
1 ; Brief (12 months) Medical Record Information
+1 DO REQUEST^AFJXWCP1("PB")
+2 QUIT
2 ; Total Medical Record Information
+1 DO REQUEST^AFJXWCP1("P")
+2 QUIT
3 ; Brief (12 months) Pharmacy Information
+1 DO REQUEST^AFJXWCP1("RB")
+2 QUIT
4 ; Total Pharmacy Information
+1 DO REQUEST^AFJXWCP1("R")
+2 QUIT
5 ; Print (Completed Requests Only)
+1 DO ENTER^AFJXMBOX
+2 QUIT
6 ; Print By Type of Information (Completed Requests)
+1 DO ENTER^AFJXMABX
+2 QUIT
HDR ; Print page header
+1 NEW AX1,AX2
+2 WRITE @IOF
+3 SET AX1="VistA Network Health Exchange Menu"
+4 SET AX2=$$NAME^XMXUTIL(DUZ)
+5 WRITE AX1,$JUSTIFY(AX2,74-$LENGTH(AX1)),!,$$REPEAT^XLFSTR("=",74)
+6 QUIT
NHEACTIV() ; Is NHE user active?
+1 NEW AXNHEDUZ,AXTXT,AXI
+2 SET AXI=0
+3 SET AXNHEDUZ=$$FIND1^DIC(200,"","X","NETWORK,HEALTH EXCHANGE")
+4 IF 'AXNHEDUZ
Begin DoDot:1
+5 SET AXI=AXI+1
SET AXTXT(AXI)="The NETWORK,HEALTH EXCHANGE user is not in the NEW PERSON file."
End DoDot:1
+6 IF '$TEST
IF $PIECE($GET(^VA(200,AXNHEDUZ,0)),U,3)=""
Begin DoDot:1
+7 SET AXI=AXI+1
SET AXTXT(AXI)="The NETWORK,HEALTH EXCHANGE user does not have an access code."
End DoDot:1
+8 IF '$DATA(^XMB(3.7,+AXNHEDUZ,2))
Begin DoDot:1
+9 SET AXI=AXI+1
SET AXTXT(AXI)="The NETWORK,HEALTH EXCHANGE user does not have a MAILBOX."
End DoDot:1
+10 if 'AXI
QUIT 1
+11 WRITE $CHAR(7),!
+12 SET AXI=0
FOR
SET AXI=$ORDER(AXTXT(AXI))
if 'AXI
QUIT
WRITE !,AXTXT(AXI)
+13 WRITE !!,"Please inform IRM."
+14 WRITE !,"Until this is corrected, you will not be able to use this option."
+15 QUIT 0
