INHOM.m

INHOM(UIF) ;JSH;08:58 AM  17 Oct 1997;Interface - send to MailMan ; 07 Oct 91   6:43 AM

 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 ;COPYRIGHT 1991-2000 SAIC

 ;

 ;UIF = entry # in Universal Interface File

 ;

 S X="ERR^INHOM",@^%ZOSF("TRAP")

 K (UIF,XUAUDIT,XUTIMP,XUTIMT,XUTIMH,INBPN,INHSRVR)

 X $G(^INTHOS(1,2)) K ^INLHSCH("GO")

 D SETENV^INHUT7

 I '$D(^INTHU(+$G(UIF),0)) D ERROR^INHOS("Missing UIF entry #"_$G(UIF),"M") G Q

 N DEST S DEST=+$P(^INTHU(UIF,0),U,2)

 I '$D(^INRHD(DEST,0)) D ERROR^INHOS("Missing DESTINATION entry #"_$G(UIF),"M") G Q

 S X=$P($G(^INRHSITE(1,0)),U,6) X:X ^%ZOSF("PRIORITY")

 K XMY,INMESS,XMZ,INHER

 S REC=$P(^INRHD(DEST,0),U,4) I REC="" D ERROR^INHOS("Missing mail recipient for DESTINATION '"_$P(^INRHD(DEST,0),U)_"'","M") G Q

 ;Start transaction audit

 D:$D(XUAUDIT) TTSTRT^XUSAUD(UIF,"",$P($G(^INTHPC(INBPN,0)),U),$G(INHSRVR),"MAIL")

 D

 . I $E(REC,1,2)="G."!($E(REC,1,2)="g.") S X=REC,XMDUZ=0 D WHO^XMA21 Q

 . S XMY(REC)=""

 S I=0 F  S I=$O(^INTHU(UIF,3,I)) Q:'I  S INMESS(I,0)=^(I,0),L=$L(INMESS(I,0)) S:$E(INMESS(I,0),L-3,L)="|CR|" INMESS(I,0)=$E(INMESS(I,0),1,L-4)

 S XMDUZ=.5,XMTEXT="INMESS("

 S XMSUB=$P(^INRHD(DEST,0),U,7) S:XMSUB="" XMSUB="GIS Transaction"

 K INHERR N ZTSK S ZTSK="" D ^XMD S ER=0

 S:'$G(XMZ) ER=2,INHERR(1)="GIS Transaction rejected by MailMan"

 ;Stop transaction audit with "complete" code.

 D:$D(XUAUDIT) TTSTP^XUSAUD(0)

 K INTT D DONE^INHOS

Q Q

 ;

ERR ;Process and error

 ;Stop transaction audit with error code.

 D:$D(XUAUDIT) TTSTP^XUSAUD(1)

 D ENT^INHE(UIF,DEST,$$ERRMSG^INHU1) X ^INTHOS(1,3) G Q

 ;

INHOM(UIF) ;JSH;08:58 AM  17 Oct 1997;Interface - send to MailMan ; 07 Oct 91   6:43 AM

 +1       ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 +2       ;COPYRIGHT 1991-2000 SAIC

 +3       ;

 +4       ;UIF = entry # in Universal Interface File

 +5       ;

 +6        SET X="ERR^INHOM"

           SET @^%ZOSF("TRAP")

 +7        KILL (UIF,XUAUDIT,XUTIMP,XUTIMT,XUTIMH,INBPN,INHSRVR)

 +8        XECUTE $GET(^INTHOS(1,2))

           KILL ^INLHSCH("GO")

 +9        DO SETENV^INHUT7

 +10       IF '$DATA(^INTHU(+$GET(UIF),0))

               DO ERROR^INHOS("Missing UIF entry #"_$GET(UIF),"M")

               GOTO Q

 +11       NEW DEST

           SET DEST=+$PIECE(^INTHU(UIF,0),U,2)

 +12       IF '$DATA(^INRHD(DEST,0))

               DO ERROR^INHOS("Missing DESTINATION entry #"_$GET(UIF),"M")

               GOTO Q

 +13       SET X=$PIECE($GET(^INRHSITE(1,0)),U,6)

           IF X

               XECUTE ^%ZOSF("PRIORITY")

 +14       KILL XMY,INMESS,XMZ,INHER

 +15       SET REC=$PIECE(^INRHD(DEST,0),U,4)

           IF REC=""

               DO ERROR^INHOS("Missing mail recipient for DESTINATION '"_$PIECE(^INRHD(DEST,0),U)_"'","M")

               GOTO Q

 +16      ;Start transaction audit

 +17       IF $DATA(XUAUDIT)

               DO TTSTRT^XUSAUD(UIF,"",$PIECE($GET(^INTHPC(INBPN,0)),U),$GET(INHSRVR),"MAIL")

 +18       Begin DoDot:1

 +19           IF $EXTRACT(REC,1,2)="G."!($EXTRACT(REC,1,2)="g.")

                   SET X=REC

                   SET XMDUZ=0

                   DO WHO^XMA21

                   QUIT 

 +20           SET XMY(REC)=""

           End DoDot:1

 +21       SET I=0

           FOR 

               SET I=$ORDER(^INTHU(UIF,3,I))

               IF 'I

                   QUIT 

               SET INMESS(I,0)=^(I,0)

               SET L=$LENGTH(INMESS(I,0))

               IF $EXTRACT(INMESS(I,0),L-3,L)="|CR|"

                   SET INMESS(I,0)=$EXTRACT(INMESS(I,0),1,L-4)

 +22       SET XMDUZ=.5

           SET XMTEXT="INMESS("

 +23       SET XMSUB=$PIECE(^INRHD(DEST,0),U,7)

           IF XMSUB=""

               SET XMSUB="GIS Transaction"

 +24       KILL INHERR

           NEW ZTSK

           SET ZTSK=""

           DO ^XMD

           SET ER=0

 +25       IF '$GET(XMZ)

               SET ER=2

               SET INHERR(1)="GIS Transaction rejected by MailMan"

 +26      ;Stop transaction audit with "complete" code.

 +27       IF $DATA(XUAUDIT)

               DO TTSTP^XUSAUD(0)

 +28       KILL INTT

           DO DONE^INHOS

Q          QUIT 

 +1       ;

ERR       ;Process and error

 +1       ;Stop transaction audit with error code.

 +2        IF $DATA(XUAUDIT)

               DO TTSTP^XUSAUD(1)

 +3        DO ENT^INHE(UIF,DEST,$$ERRMSG^INHU1)

           XECUTE ^INTHOS(1,3)

           GOTO Q

 +4       ;