APSPESIB.m

APSPESIB ;IHS/MSC/PLS - SureScripts HL7 interface - con't;01-Aug-2013 11:37;PLS

 ;;7.0;IHS PHARMACY MODIFICATIONS;**1009,1016**;Sep 23, 2004;Build 74

 Q

TSK ;EP - Entry point for APSPES INBOUND PROCESSOR

 N MSGDT,MSGTYP,MSGEVT,MSGIEN,QNM,QIEN

 S QNM="APSP RPMS"

 Q:'$$GETIEN^HLOAPP(QNM)  ;The APSP RPMS entry in HLO APPLICATION REGISTRY is missing.

 S MSGDT=""

 F  S MSGDT=$O(^HLB("QUEUE","IN",MSGDT)) Q:MSGDT=""  D

 .S MSGTYP=""

 .F  S MSGTYP=$O(^HLB("QUEUE","IN",MSGDT,QNM,MSGTYP)) Q:MSGTYP=""  D

 ..S MSGEVT=""

 ..F  S MSGEVT=$O(^HLB("QUEUE","IN",MSGDT,QNM,MSGTYP,MSGEVT)) Q:MSGEVT=""  D

 ...S MSGIEN=""

 ...F  S MSGIEN=$O(^HLB("QUEUE","IN",MSGDT,QNM,MSGTYP,MSGEVT,MSGIEN)) Q:MSGIEN=""  D

 ....D PROC(MSGIEN)

 Q

 ; Process a single message

PROC(MSGIEN) ;EP

 N PDAYS

 S PDAYS=+$$GET^XPAR("ALL","APSP SS HLO RETENTION DAYS")

 S:'PDAYS PDAYS=7  ;Set default of 7 days

 D PROCNOW^HLOAPI3(MSGIEN,$$FMADD^XLFDT($$NOW^XLFDT,PDAYS))

 K ^HLB("QUEUE","IN",MSGDT,QNM,MSGTYP,MSGEVT,MSGIEN)  ;Remove from "IN" queue

 Q

 ;

PURG ;EP - Entry point for APSPES HLO PURGE

 N PURDT,MSGIEN,PURNOW,QNM

 S QNM="APSP RPMS"

 S PURNOW=$$NOW^XLFDT

 S PURDT=""

 F  S PURDT=$O(^HLB("AD","IN",PURDT)) Q:'PURDT!(PURDT>PURNOW)  D

 .S MSGIEN=""

 .F  S MSGIEN=$O(^HLB("AD","IN",PURDT,MSGIEN)) Q:'MSGIEN  D

 ..Q:'$$VALIDMSG(MSGIEN)

 ..D DELETE^HLOPURGE(MSGIEN)

 Q

 ; Verifies that message is for APSP RPMS

VALIDMSG(MSGIEN) ;EP-

 N MSG,RES

 S RES=$$STARTMSG^HLOPRS(.MSG,MSGIEN)

 Q:'RES RES

 Q MSG("HDR","RECEIVING APPLICATION")=QNM

APSPESIB  ;IHS/MSC/PLS - SureScripts HL7 interface - con't;01-Aug-2013 11:37;PLS

 +1       ;;7.0;IHS PHARMACY MODIFICATIONS;**1009,1016**;Sep 23, 2004;Build 74

 +2        QUIT 

TSK       ;EP - Entry point for APSPES INBOUND PROCESSOR

 +1        NEW MSGDT,MSGTYP,MSGEVT,MSGIEN,QNM,QIEN

 +2        SET QNM="APSP RPMS"

 +3       ;The APSP RPMS entry in HLO APPLICATION REGISTRY is missing.

           IF '$$GETIEN^HLOAPP(QNM)

               QUIT 

 +4        SET MSGDT=""

 +5        FOR 

               SET MSGDT=$ORDER(^HLB("QUEUE","IN",MSGDT))

               IF MSGDT=""

                   QUIT 

               Begin DoDot:1

 +6                SET MSGTYP=""

 +7                FOR 

                       SET MSGTYP=$ORDER(^HLB("QUEUE","IN",MSGDT,QNM,MSGTYP))

                       IF MSGTYP=""

                           QUIT 

                       Begin DoDot:2

 +8                        SET MSGEVT=""

 +9                        FOR 

                               SET MSGEVT=$ORDER(^HLB("QUEUE","IN",MSGDT,QNM,MSGTYP,MSGEVT))

                               IF MSGEVT=""

                                   QUIT 

                               Begin DoDot:3

 +10                               SET MSGIEN=""

 +11                               FOR 

                                       SET MSGIEN=$ORDER(^HLB("QUEUE","IN",MSGDT,QNM,MSGTYP,MSGEVT,MSGIEN))

                                       IF MSGIEN=""

                                           QUIT 

                                       Begin DoDot:4

 +12                                       DO PROC(MSGIEN)

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +13       QUIT 

 +14      ; Process a single message

PROC(MSGIEN) ;EP

 +1        NEW PDAYS

 +2        SET PDAYS=+$$GET^XPAR("ALL","APSP SS HLO RETENTION DAYS")

 +3       ;Set default of 7 days

           IF 'PDAYS

               SET PDAYS=7

 +4        DO PROCNOW^HLOAPI3(MSGIEN,$$FMADD^XLFDT($$NOW^XLFDT,PDAYS))

 +5       ;Remove from "IN" queue

           KILL ^HLB("QUEUE","IN",MSGDT,QNM,MSGTYP,MSGEVT,MSGIEN)

 +6        QUIT 

 +7       ;

PURG      ;EP - Entry point for APSPES HLO PURGE

 +1        NEW PURDT,MSGIEN,PURNOW,QNM

 +2        SET QNM="APSP RPMS"

 +3        SET PURNOW=$$NOW^XLFDT

 +4        SET PURDT=""

 +5        FOR 

               SET PURDT=$ORDER(^HLB("AD","IN",PURDT))

               IF 'PURDT!(PURDT>PURNOW)

                   QUIT 

               Begin DoDot:1

 +6                SET MSGIEN=""

 +7                FOR 

                       SET MSGIEN=$ORDER(^HLB("AD","IN",PURDT,MSGIEN))

                       IF 'MSGIEN

                           QUIT 

                       Begin DoDot:2

 +8                        IF '$$VALIDMSG(MSGIEN)

                               QUIT 

 +9                        DO DELETE^HLOPURGE(MSGIEN)

                       End DoDot:2

               End DoDot:1

 +10       QUIT 

 +11      ; Verifies that message is for APSP RPMS

VALIDMSG(MSGIEN) ;EP-

 +1        NEW MSG,RES

 +2        SET RES=$$STARTMSG^HLOPRS(.MSG,MSGIEN)

 +3        IF 'RES

               QUIT RES

 +4        QUIT MSG("HDR","RECEIVING APPLICATION")=QNM