AFJXWCP1.m

AFJXWCP1 ;FO-OAKLAND/GMB-REQUEST PATIENT INFORMATION ;4/11/96  05:36

 ;;5.1;Network Health Exchange;**1,31,34**;Jan 23, 1996

 ; Totally rewritten 11/2001.  (Previously FJ/CWS.)

 ; Called from ^AFJXWCPM

REQUEST(AXTYPE) ; Request data

 N AXFINIS,AXABORT,AXPARM,AXSSN,I

 S (AXFINIS,AXABORT)=0

 D INIT(AXTYPE,.AXPARM,.AXABORT) Q:AXABORT

 W @IOF,!! F I=1:1:80 W "@"

 W !,?8,"This option will request ",AXPARM("U")," DATA from another VAMC."

 W ! F I=1:1:80 W "@"

 W !!,?5,"You can't request information if the patient is not already on file.",!

 F  D  Q:AXFINIS!AXABORT

 . N DIC,X,Y,AXTO

 . W !!

 . S DIC("A")="SOCIAL SECURITY # or NAME: "

 . S DIC="^DPT("

 . S DIC(0)="AEMOQZ"

 . D ^DIC I Y<1 S AXFINIS=1 Q

 . S AXSSN=$P(Y(0),U,9)

 . I $G(AXSSN)["P" W !,?5,$C(7),"SORRY, You can't request Pseudo SSNs." Q

 . D SITES(.AXTO,.AXABORT) Q:AXABORT

 . I '$D(AXTO) D  Q

 . . W !,$C(7),"No valid sites chosen.  No request sent."

 . D MESSAGE(.AXTO,AXSSN)

 Q

INIT(AXTYPE,AXPARM,AXABORT) ;

 I AXTYPE="R" S AXPARM("U")="PATIENT PHARMACY",AXPARM("S")="PHARMACY DATA",AXPARM("L")="PHARM"

 E  I AXTYPE="RB" S AXPARM("U")="BRIEF PHARMACY",AXPARM("S")="BRIEF PHARMACY",AXPARM("L")="NHBP"

 E  I AXTYPE="P" S AXPARM("U")="PATIENT",AXPARM("S")="TOTAL DATA",AXPARM("L")="TOTAL"

 E  I AXTYPE="PB" S AXPARM("U")="BRIEF PATIENT",AXPARM("S")="BRIEF DATA",AXPARM("L")="BRIEF"

 E  D  Q

 . W !,"Routine ^AFJXWCP1 called with incorrect TYPE parameter: ",AXTYPE

 . S AXABORT=1

 N DIR,X,Y

 W !

 S DIR(0)="Y"

 S DIR("A")="Would you like to look for any previous requests on file"

 S DIR("B")="NO"

 D ^DIR I $D(DTOUT)!$D(DUOUT) S AXABORT=1 Q

 D:Y ENTER^AFJXMBOX

 Q

SITES(AXTO,AXABORT) ; Choose station(s)

 N AXFINIS,AXDOMIEN,AX25IEN,DIR,X,Y,DIRUT

 S DIR(0)="S^A:ALL Local Area Sites;S:Selected Sites"

 S DIR("A")="Request patient information from"

 D ^DIR I $D(DIRUT) S AXABORT=1 Q

 I Y="A" D CHKALL(.AXTO) Q

 K DIR,X,Y

 S AXFINIS=0

 F  D  Q:AXFINIS!AXABORT

 . N DIC,X,Y,DUOUT,DTOUT

 . W !

 . S DIC=537025,DIC(0)="AEMOQ"

 . S DIC("A")=$S($D(AXTO):"Another site: ",1:"Select a site: ")

 . S DIC("S")="I $P($G(^DIC(4.2,+^(0),0)),U,2)'[""C"""

 . D ^DIC I $D(DUOUT)!$D(DTOUT) S AXABORT=1 Q

 . I Y<1 S AXFINIS=1 Q

 . S AXDOMIEN=$P(Y,U,2),AX25IEN=+Y

 . D CHKSITE(AXDOMIEN,AX25IEN,.AXTO)

 Q

CHKALL(AXTO) ; "ALL LOCAL AREA SITES"

 N AX25IEN,AX25REC

 W !,"Network Area Recipients:"

 S AX25IEN=0

 F  S AX25IEN=$O(^AFJ(537025,AX25IEN)) Q:'AX25IEN  D

 . S AX25REC=$G(^AFJ(537025,AX25IEN,0))

 . I $P(AX25REC,U,3) D CHKSITE($P(AX25REC,U),AX25IEN,.AXTO)

 Q

CHKSITE(AXDOMIEN,AX25IEN,AXTO) ;

 N AXBAD,AXDOMREC

 S AXBAD=0

 I AXDOMIEN=^XMB("NUM") D

 . ;S AXBAD=1

 . S AXTO("S.AFJXSERVER")=""

 . W !,^XMB("NETNAME"),"   FYI: That's this domain."

 . S AXTO("S.AFJXSERVER")=""

 E  D

 . S AXDOMREC=$P(^DIC(4.2,AXDOMIEN,0),U,1,2)

 . I AXDOMREC="" D  Q

 . . S AXBAD=1

 . . ;W !!,$C(7),"Broken pointer to the DOMAIN file."

 . I $P(AXDOMREC,U,2)'["C" D  Q

 . . S AXTO("S.AFJXSERVER@"_$P(AXDOMREC,U,1))=""

 . . W !,$P(AXDOMREC,U,1)

 . S AXBAD=1

 . ;W !!,$C(7),"Domain ",DOMNAME," is closed."

 Q:'AXBAD

 ;W !,"   Ignoring it."

 Q

 ;W !,"   Deleting it from the Authorized Sites file."

 ;N DIK,DA S DIK="^AFJ(537025,",DA=AX25IEN D ^DIK

 ;Q

MESSAGE(XMY,AXSSN) ; Build message and transmit

 N XMSUB,XMDUZ,XMTEXT,XMZ,AXRQST,AXREC,DIC,DLAYGO,X,Y,DA,DINUM,DD,DO

 W !!,"Sending Patient Data Request..."

 S XMDUZ=DUZ,XMTEXT="AXRQST("

 S XMSUB="NETWORK HEALTH EXCHANGE "_AXPARM("S")_" REQUEST FOR "_AXSSN

 S AXRQST(1)=AXSSN_U_DUZ_U_$P($G(^VA(200,+DUZ,0)),U)_U_$$NOW^XLFDT_U_^XMB("NETNAME")_U_AXPARM("L")

 D ^XMD W !,"Local Message ID: "_XMZ

 ; Audit

 S AXREC=AXRQST(1)

 S DIC="^AFJ(537000,",DLAYGO=537000

 S DIC(0)="L",X=XMZ

 S DIC("DR")="1////"_$P(AXREC,U,4)_";2////"_AXPARM("L")_";3////"_AXSSN_";6////"_DUZ_";7////"_$P(AXREC,U,3)_";8////"_^XMB("NUM")_";11////Y"

 D FILE^DICN

 W !!,"Your request has been submitted for completion."

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---AFJXWCP1   3969     printed  Apr 23, 2025@18:32:30                                                                                                                                                                                                    Page 2

AFJXWCP1  ;FO-OAKLAND/GMB-REQUEST PATIENT INFORMATION ;4/11/96  05:36

 +1       ;;5.1;Network Health Exchange;**1,31,34**;Jan 23, 1996

 +2       ; Totally rewritten 11/2001.  (Previously FJ/CWS.)

 +3       ; Called from ^AFJXWCPM

REQUEST(AXTYPE) ; Request data

 +1        NEW AXFINIS,AXABORT,AXPARM,AXSSN,I

 +2        SET (AXFINIS,AXABORT)=0

 +3        DO INIT(AXTYPE,.AXPARM,.AXABORT)

           if AXABORT

               QUIT 

 +4        WRITE @IOF,!!

           FOR I=1:1:80

               WRITE "@"

 +5        WRITE !,?8,"This option will request ",AXPARM("U")," DATA from another VAMC."

 +6        WRITE !

           FOR I=1:1:80

               WRITE "@"

 +7        WRITE !!,?5,"You can't request information if the patient is not already on file.",!

 +8        FOR 

               Begin DoDot:1

 +9                NEW DIC,X,Y,AXTO

 +10               WRITE !!

 +11               SET DIC("A")="SOCIAL SECURITY # or NAME: "

 +12               SET DIC="^DPT("

 +13               SET DIC(0)="AEMOQZ"

 +14               DO ^DIC

                   IF Y<1

                       SET AXFINIS=1

                       QUIT 

 +15               SET AXSSN=$PIECE(Y(0),U,9)

 +16               IF $GET(AXSSN)["P"

                       WRITE !,?5,$CHAR(7),"SORRY, You can't request Pseudo SSNs."

                       QUIT 

 +17               DO SITES(.AXTO,.AXABORT)

                   if AXABORT

                       QUIT 

 +18               IF '$DATA(AXTO)

                       Begin DoDot:2

 +19                       WRITE !,$CHAR(7),"No valid sites chosen.  No request sent."

                       End DoDot:2

                       QUIT 

 +20               DO MESSAGE(.AXTO,AXSSN)

               End DoDot:1

               if AXFINIS!AXABORT

                   QUIT 

 +21       QUIT 

INIT(AXTYPE,AXPARM,AXABORT) ;

 +1        IF AXTYPE="R"

               SET AXPARM("U")="PATIENT PHARMACY"

               SET AXPARM("S")="PHARMACY DATA"

               SET AXPARM("L")="PHARM"

 +2       IF '$TEST

               IF AXTYPE="RB"

                   SET AXPARM("U")="BRIEF PHARMACY"

                   SET AXPARM("S")="BRIEF PHARMACY"

                   SET AXPARM("L")="NHBP"

 +3       IF '$TEST

               IF AXTYPE="P"

                   SET AXPARM("U")="PATIENT"

                   SET AXPARM("S")="TOTAL DATA"

                   SET AXPARM("L")="TOTAL"

 +4       IF '$TEST

               IF AXTYPE="PB"

                   SET AXPARM("U")="BRIEF PATIENT"

                   SET AXPARM("S")="BRIEF DATA"

                   SET AXPARM("L")="BRIEF"

 +5       IF '$TEST

               Begin DoDot:1

 +6                WRITE !,"Routine ^AFJXWCP1 called with incorrect TYPE parameter: ",AXTYPE

 +7                SET AXABORT=1

               End DoDot:1

               QUIT 

 +8        NEW DIR,X,Y

 +9        WRITE !

 +10       SET DIR(0)="Y"

 +11       SET DIR("A")="Would you like to look for any previous requests on file"

 +12       SET DIR("B")="NO"

 +13       DO ^DIR

           IF $DATA(DTOUT)!$DATA(DUOUT)

               SET AXABORT=1

               QUIT 

 +14       if Y

               DO ENTER^AFJXMBOX

 +15       QUIT 

SITES(AXTO,AXABORT) ; Choose station(s)

 +1        NEW AXFINIS,AXDOMIEN,AX25IEN,DIR,X,Y,DIRUT

 +2        SET DIR(0)="S^A:ALL Local Area Sites;S:Selected Sites"

 +3        SET DIR("A")="Request patient information from"

 +4        DO ^DIR

           IF $DATA(DIRUT)

               SET AXABORT=1

               QUIT 

 +5        IF Y="A"

               DO CHKALL(.AXTO)

               QUIT 

 +6        KILL DIR,X,Y

 +7        SET AXFINIS=0

 +8        FOR 

               Begin DoDot:1

 +9                NEW DIC,X,Y,DUOUT,DTOUT

 +10               WRITE !

 +11               SET DIC=537025

                   SET DIC(0)="AEMOQ"

 +12               SET DIC("A")=$SELECT($DATA(AXTO):"Another site: ",1:"Select a site: ")

 +13               SET DIC("S")="I $P($G(^DIC(4.2,+^(0),0)),U,2)'[""C"""

 +14               DO ^DIC

                   IF $DATA(DUOUT)!$DATA(DTOUT)

                       SET AXABORT=1

                       QUIT 

 +15               IF Y<1

                       SET AXFINIS=1

                       QUIT 

 +16               SET AXDOMIEN=$PIECE(Y,U,2)

                   SET AX25IEN=+Y

 +17               DO CHKSITE(AXDOMIEN,AX25IEN,.AXTO)

               End DoDot:1

               if AXFINIS!AXABORT

                   QUIT 

 +18       QUIT 

CHKALL(AXTO) ; "ALL LOCAL AREA SITES"

 +1        NEW AX25IEN,AX25REC

 +2        WRITE !,"Network Area Recipients:"

 +3        SET AX25IEN=0

 +4        FOR 

               SET AX25IEN=$ORDER(^AFJ(537025,AX25IEN))

               if 'AX25IEN

                   QUIT 

               Begin DoDot:1

 +5                SET AX25REC=$GET(^AFJ(537025,AX25IEN,0))

 +6                IF $PIECE(AX25REC,U,3)

                       DO CHKSITE($PIECE(AX25REC,U),AX25IEN,.AXTO)

               End DoDot:1

 +7        QUIT 

CHKSITE(AXDOMIEN,AX25IEN,AXTO) ;

 +1        NEW AXBAD,AXDOMREC

 +2        SET AXBAD=0

 +3        IF AXDOMIEN=^XMB("NUM")

               Begin DoDot:1

 +4       ;S AXBAD=1

 +5                SET AXTO("S.AFJXSERVER")=""

 +6                WRITE !,^XMB("NETNAME"),"   FYI: That's this domain."

 +7                SET AXTO("S.AFJXSERVER")=""

               End DoDot:1

 +8       IF '$TEST

               Begin DoDot:1

 +9                SET AXDOMREC=$PIECE(^DIC(4.2,AXDOMIEN,0),U,1,2)

 +10               IF AXDOMREC=""

                       Begin DoDot:2

 +11                       SET AXBAD=1

 +12      ;W !!,$C(7),"Broken pointer to the DOMAIN file."

                       End DoDot:2

                       QUIT 

 +13               IF $PIECE(AXDOMREC,U,2)'["C"

                       Begin DoDot:2

 +14                       SET AXTO("S.AFJXSERVER@"_$PIECE(AXDOMREC,U,1))=""

 +15                       WRITE !,$PIECE(AXDOMREC,U,1)

                       End DoDot:2

                       QUIT 

 +16               SET AXBAD=1

 +17      ;W !!,$C(7),"Domain ",DOMNAME," is closed."

               End DoDot:1

 +18       if 'AXBAD

               QUIT 

 +19      ;W !,"   Ignoring it."

 +20       QUIT 

 +21      ;W !,"   Deleting it from the Authorized Sites file."

 +22      ;N DIK,DA S DIK="^AFJ(537025,",DA=AX25IEN D ^DIK

 +23      ;Q

MESSAGE(XMY,AXSSN) ; Build message and transmit

 +1        NEW XMSUB,XMDUZ,XMTEXT,XMZ,AXRQST,AXREC,DIC,DLAYGO,X,Y,DA,DINUM,DD,DO

 +2        WRITE !!,"Sending Patient Data Request..."

 +3        SET XMDUZ=DUZ

           SET XMTEXT="AXRQST("

 +4        SET XMSUB="NETWORK HEALTH EXCHANGE "_AXPARM("S")_" REQUEST FOR "_AXSSN

 +5        SET AXRQST(1)=AXSSN_U_DUZ_U_$PIECE($GET(^VA(200,+DUZ,0)),U)_U_$$NOW^XLFDT_U_^XMB("NETNAME")_U_AXPARM("L")

 +6        DO ^XMD

           WRITE !,"Local Message ID: "_XMZ

 +7       ; Audit

 +8        SET AXREC=AXRQST(1)

 +9        SET DIC="^AFJ(537000,"

           SET DLAYGO=537000

 +10       SET DIC(0)="L"

           SET X=XMZ

 +11       SET DIC("DR")="1////"_$PIECE(AXREC,U,4)_";2////"_AXPARM("L")_";3////"_AXSSN_";6////"_DUZ_";7////"_$PIECE(AXREC,U,3)_";8////"_^XMB("NUM")_";11////Y"

 +12       DO FILE^DICN

 +13       WRITE !!,"Your request has been submitted for completion."

 +14       QUIT