DGRUADT1.m

DGRUADT1 ;ALB/SCK - MAIN BUILDER FOR RAI/MDS ADT MESSAGING ; 7-8-1999

 ;;5.3;Registration;**190,480,1015**;Aug 13, 1993;Build 21

 ;

BLDMSG(DFN,EVCODE,DGIEN,VAFHDT,DGWARD,DGOLDT,DGDTYP) ;

 ; INPUT

 ;   DFN     - Ien in Patient File

 ;   EVCODE  - HL7 event code

 ;   DGIEN   - Ien of the Movement

 ;   VAFHDT  - Date of event

 ;   DGWARD  - Associated ward

 ;   DGOLDT  - Old date of ADT even for change to date [Optional]

 ;   DGDTYP  - Change Date type [Optional]

 ;              A - Admission date

 ;              T - Transfer Date

 ;              D - Discharge Date

 ;

 Q:"A01,A02,A03,A08,A11,A12,A13,A21,A22"'[$G(EVCODE)

 ;

 K HL,HLA,XMTARRY,HLRST

 ;

 D INIT^HLFNC2("DGRU-RAI-"_EVCODE_"-SERVER",.HL)

 I $O(HL(""))']"" D  Q

 . D ERRBUL(DFN,DT,EVCODE,"-1^Server Protocol not found")

 ;

 S DGOLDT=$G(DGOLDT),DGDTYP=$G(DGDTYP)

 D:EVCODE="A01" EN^DGRUGA01(DFN,DGIEN,"XMTARRY")

 D:EVCODE="A02" EN^DGRUGA02(DFN,DGIEN,"XMTARRY")

 D:EVCODE="A03" EN^DGRUGA03(DFN,DGIEN,"XMTARRY")

 ; The A11 message is a special case and requires sending the Ward.

 D:EVCODE="A11" EN^DGRUGA11(DFN,DGIEN,"XMTARRY",$G(DGWARD),$G(VAFHDT)) ;GRR 1/26/00 TEST

 D:EVCODE="A12" EN^DGRUGA12(DFN,DGIEN,"XMTARRY")

 D:EVCODE="A13" EN^DGRUGA13(DFN,DGIEN,"XMTARRY")

 D:EVCODE="A21" EN^DGRUGA21(DFN,DGIEN,"XMTARRY")

 D:EVCODE="A22" EN^DGRUGA22(DFN,DGIEN,"XMTARRY")

 D:EVCODE="A08" EN^DGRUGA08(DFN,DGIEN,"XMTARRY",DGDTYP_"^"_DGOLDT)

 ;

 I '$O(XMTARRY(0)) D  Q

 . D ERRBUL(DFN,DT,EVCODE,"-1^Unable to build segment list to transmit")

 ;

 N NDX

 S NDX=0

 F  S NDX=$O(XMTARRY(NDX)) Q:'NDX  D  Q:(+XMTARRY(NDX)<0)

 . I +XMTARRY(NDX)<0 D ERRBUL(DFN,DT,EVCODE,"-1^An error occurred in one of the segments")

 ;

 ; Load data array

 M HLA("HLS")=XMTARRY

 ;

 ; Write out message text if in trace mode

 I $D(DGTRACE) D

 . N X S X=0

 . F  S X=+$O(HLA("HLS",X)) Q:'X  W !,HLA("HLS",X)

 ;

 I $D(HLA("HLS")) D

 . D GENERATE^HLMA("DGRU-RAI-"_EVCODE_"-SERVER","LM",1,.HLRST)

 . D MSGBUL(DFN,DT,EVCODE,HLRST)

 . I $D(DGTRACE),$D(HLRST) D

 . . W !,"Message ID: ",+$G(HLRST)

 ;

 I +$P(HLRST,"^",2)>0 D  Q

 . D ERRBUL(DFN,DT,EVCODE,"-1^"_$P(HLRST,"^",2,3))

 ;

 K HLA,HLERR

 Q

 ;

MSGBUL(DFN,DT,EVCODE,MSGID) ;

 N XMY,XMDUZ,XMDT,XMZ,XMB,XMCHAN,XMSUB

 ;

 S XMCHAN=1

 S XMSUB="RAI/MDS HL7 MESSAGE XMIT"

 S (XMDUZ,XMDUZ)="RAI/MDS APPLICATION"

 ;

 S XMB="DGRU HL7SND"

 S XMB(1)=EVCODE

 S XMB(2)=$$GET1^DIQ(2,DFN,.01)

 S XMB(3)=+MSGID

 S XMB(4)=$$FMTE^XLFDT(DT)

 S XMB(5)=$$GET1^DIQ(2,DFN,.09) ; p-480 mg

 S XMDT=$$NOW^XLFDT

 D ^XMB

 Q

 ;

ERRBUL(DFN,DT,EVCODE,ERRMSG) ;

 N XMY,XMDUZ,XMDT,XMZ,XMB,XMCHAN,XMSUB

 ;

 S XMCHAN=1

 S XMSUB="RAI/MDS HL7 ADT ERROR"

 S (XMDUZ,XMDUZ)="RAI/MDS APPLICATION"

 ;

 S XMB="DGRU RAI ERROR"

 S XMB(1)=$$GET1^DIQ(2,DFN,.01)

 S XMB(2)=EVCODE

 S XMB(3)=">>> "_$P(ERRMSG,"^",2)

 S XMB(4)=$S($G(DUZ)>0:$$GET1^DIQ(200,DUZ,.01),1:"")

 S XMB(5)=$$FMTE^XLFDT($$NOW^XLFDT)

 S XMDT=DT

 D ^XMB

 Q

DGRUADT1  ;ALB/SCK - MAIN BUILDER FOR RAI/MDS ADT MESSAGING ; 7-8-1999

 +1       ;;5.3;Registration;**190,480,1015**;Aug 13, 1993;Build 21

 +2       ;

BLDMSG(DFN,EVCODE,DGIEN,VAFHDT,DGWARD,DGOLDT,DGDTYP) ;

 +1       ; INPUT

 +2       ;   DFN     - Ien in Patient File

 +3       ;   EVCODE  - HL7 event code

 +4       ;   DGIEN   - Ien of the Movement

 +5       ;   VAFHDT  - Date of event

 +6       ;   DGWARD  - Associated ward

 +7       ;   DGOLDT  - Old date of ADT even for change to date [Optional]

 +8       ;   DGDTYP  - Change Date type [Optional]

 +9       ;              A - Admission date

 +10      ;              T - Transfer Date

 +11      ;              D - Discharge Date

 +12      ;

 +13       IF "A01,A02,A03,A08,A11,A12,A13,A21,A22"'[$GET(EVCODE)

               QUIT 

 +14      ;

 +15       KILL HL,HLA,XMTARRY,HLRST

 +16      ;

 +17       DO INIT^HLFNC2("DGRU-RAI-"_EVCODE_"-SERVER",.HL)

 +18       IF $ORDER(HL(""))']""

               Begin DoDot:1

 +19               DO ERRBUL(DFN,DT,EVCODE,"-1^Server Protocol not found")

               End DoDot:1

               QUIT 

 +20      ;

 +21       SET DGOLDT=$GET(DGOLDT)

           SET DGDTYP=$GET(DGDTYP)

 +22       IF EVCODE="A01"

               DO EN^DGRUGA01(DFN,DGIEN,"XMTARRY")

 +23       IF EVCODE="A02"

               DO EN^DGRUGA02(DFN,DGIEN,"XMTARRY")

 +24       IF EVCODE="A03"

               DO EN^DGRUGA03(DFN,DGIEN,"XMTARRY")

 +25      ; The A11 message is a special case and requires sending the Ward.

 +26      ;GRR 1/26/00 TEST

           IF EVCODE="A11"

               DO EN^DGRUGA11(DFN,DGIEN,"XMTARRY",$GET(DGWARD),$GET(VAFHDT))

 +27       IF EVCODE="A12"

               DO EN^DGRUGA12(DFN,DGIEN,"XMTARRY")

 +28       IF EVCODE="A13"

               DO EN^DGRUGA13(DFN,DGIEN,"XMTARRY")

 +29       IF EVCODE="A21"

               DO EN^DGRUGA21(DFN,DGIEN,"XMTARRY")

 +30       IF EVCODE="A22"

               DO EN^DGRUGA22(DFN,DGIEN,"XMTARRY")

 +31       IF EVCODE="A08"

               DO EN^DGRUGA08(DFN,DGIEN,"XMTARRY",DGDTYP_"^"_DGOLDT)

 +32      ;

 +33       IF '$ORDER(XMTARRY(0))

               Begin DoDot:1

 +34               DO ERRBUL(DFN,DT,EVCODE,"-1^Unable to build segment list to transmit")

               End DoDot:1

               QUIT 

 +35      ;

 +36       NEW NDX

 +37       SET NDX=0

 +38       FOR 

               SET NDX=$ORDER(XMTARRY(NDX))

               IF 'NDX

                   QUIT 

               Begin DoDot:1

 +39               IF +XMTARRY(NDX)<0

                       DO ERRBUL(DFN,DT,EVCODE,"-1^An error occurred in one of the segments")

               End DoDot:1

               IF (+XMTARRY(NDX)<0)

                   QUIT 

 +40      ;

 +41      ; Load data array

 +42       MERGE HLA("HLS")=XMTARRY

 +43      ;

 +44      ; Write out message text if in trace mode

 +45       IF $DATA(DGTRACE)

               Begin DoDot:1

 +46               NEW X

                   SET X=0

 +47               FOR 

                       SET X=+$ORDER(HLA("HLS",X))

                       IF 'X

                           QUIT 

                       WRITE !,HLA("HLS",X)

               End DoDot:1

 +48      ;

 +49       IF $DATA(HLA("HLS"))

               Begin DoDot:1

 +50               DO GENERATE^HLMA("DGRU-RAI-"_EVCODE_"-SERVER","LM",1,.HLRST)

 +51               DO MSGBUL(DFN,DT,EVCODE,HLRST)

 +52               IF $DATA(DGTRACE)

                       IF $DATA(HLRST)

                           Begin DoDot:2

 +53                           WRITE !,"Message ID: ",+$GET(HLRST)

                           End DoDot:2

               End DoDot:1

 +54      ;

 +55       IF +$PIECE(HLRST,"^",2)>0

               Begin DoDot:1

 +56               DO ERRBUL(DFN,DT,EVCODE,"-1^"_$PIECE(HLRST,"^",2,3))

               End DoDot:1

               QUIT 

 +57      ;

 +58       KILL HLA,HLERR

 +59       QUIT 

 +60      ;

MSGBUL(DFN,DT,EVCODE,MSGID) ;

 +1        NEW XMY,XMDUZ,XMDT,XMZ,XMB,XMCHAN,XMSUB

 +2       ;

 +3        SET XMCHAN=1

 +4        SET XMSUB="RAI/MDS HL7 MESSAGE XMIT"

 +5        SET (XMDUZ,XMDUZ)="RAI/MDS APPLICATION"

 +6       ;

 +7        SET XMB="DGRU HL7SND"

 +8        SET XMB(1)=EVCODE

 +9        SET XMB(2)=$$GET1^DIQ(2,DFN,.01)

 +10       SET XMB(3)=+MSGID

 +11       SET XMB(4)=$$FMTE^XLFDT(DT)

 +12      ; p-480 mg

           SET XMB(5)=$$GET1^DIQ(2,DFN,.09)

 +13       SET XMDT=$$NOW^XLFDT

 +14       DO ^XMB

 +15       QUIT 

 +16      ;

ERRBUL(DFN,DT,EVCODE,ERRMSG) ;

 +1        NEW XMY,XMDUZ,XMDT,XMZ,XMB,XMCHAN,XMSUB

 +2       ;

 +3        SET XMCHAN=1

 +4        SET XMSUB="RAI/MDS HL7 ADT ERROR"

 +5        SET (XMDUZ,XMDUZ)="RAI/MDS APPLICATION"

 +6       ;

 +7        SET XMB="DGRU RAI ERROR"

 +8        SET XMB(1)=$$GET1^DIQ(2,DFN,.01)

 +9        SET XMB(2)=EVCODE

 +10       SET XMB(3)=">>> "_$PIECE(ERRMSG,"^",2)

 +11       SET XMB(4)=$SELECT($GET(DUZ)>0:$$GET1^DIQ(200,DUZ,.01),1:"")

 +12       SET XMB(5)=$$FMTE^XLFDT($$NOW^XLFDT)

 +13       SET XMDT=DT

 +14       DO ^XMB

 +15       QUIT