AFJXWCPM.m

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 ---AFJXWCPM   2217     printed  Mar 13, 2025@21:23:02                                                                                                                                                                                                    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