| 1 | SCMCHL ;BP/DJB - PCMM HL7 Main Calling Point ; 16 Dec 2002  11:14 AM | 
|---|
| 2 | ;;5.3;Scheduling;**177,204,224,272,367**;AUG 13, 1993 | 
|---|
| 3 | ; | 
|---|
| 4 | ;Reference routine: SCDXMSG | 
|---|
| 5 | MAIN(MODE,XMITARRY,VARPTR,WORK) ;Main entry point to generate Primary Care HL7 | 
|---|
| 6 | ;messages to NPCD in Austin. Loop thru PCMM HL7 EVENT file (#404.48) | 
|---|
| 7 | ;and generate HL7 message for each appropriate event. | 
|---|
| 8 | ; | 
|---|
| 9 | ;Input: | 
|---|
| 10 | ;  MODE     - Mode of operation. | 
|---|
| 11 | ;              1: Generate mode - Generate HL7 messages. (Default). | 
|---|
| 12 | ;              2: Review mode   - HL7 segments will be built in array | 
|---|
| 13 | ;                                 XMITARRY and may be reviewed. HL7 | 
|---|
| 14 | ;                                 messages WILL NOT be generated, and | 
|---|
| 15 | ;                                 processed events will not be | 
|---|
| 16 | ;                                 removed from the transmit xref in | 
|---|
| 17 | ;                                 PCMM HL7 EVENT file. | 
|---|
| 18 | ;  XMITARRY - Array to store HL7 segments (full global ref). | 
|---|
| 19 | ;             Default=^TMP("PCMM","HL7",$J) | 
|---|
| 20 | ;   VARPTR  - For testing purposes, you may pass in an EVENT POINTER | 
|---|
| 21 | ;             value. This value will be used rather than $ORDERing | 
|---|
| 22 | ;             thru "AACXMIT" xref in PCMM HL7 EVENT file. | 
|---|
| 23 | ;             Examples: | 
|---|
| 24 | ;                "2290;SCPT(404.43," (Patient Team Position Assign) | 
|---|
| 25 | ;                "725;SCTM(404.52,"  (Position Assign History) | 
|---|
| 26 | ;                "1;SCTM(404.53,"    (Preceptor Assign History) | 
|---|
| 27 | ;   Work Optional if present | 
|---|
| 28 | ;Output: None | 
|---|
| 29 | ; | 
|---|
| 30 | ;Prevent multiple runs processing at the same time. | 
|---|
| 31 | I $G(VARPTR)'="",$D(^XTMP("SCMCHL")) D  Q | 
|---|
| 32 | .W !,"HL7 Transmission in progress, no testing allowed!",! | 
|---|
| 33 | I $D(^XTMP("SCMCHL")) D  Q | 
|---|
| 34 | .W !,"HL7 Transmission in progress, please try again later.",! | 
|---|
| 35 | S ^XTMP("SCMCHL",0)=DT_"^"_DT | 
|---|
| 36 | ; | 
|---|
| 37 | NEW ERRCNT,IEN,MSG,MSGCNT,RESULT | 
|---|
| 38 | NEW SCEVIEN,SCFAC | 
|---|
| 39 | NEW HL,HLECH,HLEID,HLFS,HLQ,HLP,XMITERR | 
|---|
| 40 | ; | 
|---|
| 41 | ;Initialize variables - set global locations | 
|---|
| 42 | S:$G(MODE)'=2 MODE=1 ;Default mode = "Generate" | 
|---|
| 43 | S:$G(XMITARRY)="" XMITARRY="^TMP(""PCMM"",""HL7"","_$J_")" ;Segments | 
|---|
| 44 | S XMITERR="^TMP(""PCMM"",""ERR"","_$J_")" ;Errors | 
|---|
| 45 | S MSGCNT=0 | 
|---|
| 46 | ; | 
|---|
| 47 | ;Get pointer to sending event | 
|---|
| 48 | S HLEID=$$HLEID() | 
|---|
| 49 | I 'HLEID D  Q | 
|---|
| 50 | . S MSG="Unable to initialize HL7 variables - protocol not found" | 
|---|
| 51 | . D ERRBULL^SCMCHLM(MSG) | 
|---|
| 52 | ; | 
|---|
| 53 | ;Initialize HL7 variables | 
|---|
| 54 | D INIT^HLFNC2(HLEID,.HL) | 
|---|
| 55 | I $O(HL(""))="" D  Q | 
|---|
| 56 | . D ERRBULL^SCMCHLM($P(HL,"^",2)) | 
|---|
| 57 | ; | 
|---|
| 58 | ;Get faciltiy number | 
|---|
| 59 | S SCFAC=+$P($$SITE^VASITE(),"^",3) | 
|---|
| 60 | ; | 
|---|
| 61 | ;User passed in an EVENT POINTER value | 
|---|
| 62 | I $G(VARPTR)]"" D MANUAL Q | 
|---|
| 63 | ; | 
|---|
| 64 | LOOP ;Loop thru EVENT POINTER xref and send message for each unique one. | 
|---|
| 65 | ;alb/rpm Patch 224 | 
|---|
| 66 | ;The SCLIMIT counter allows sites to limit the number of HL7 messages | 
|---|
| 67 | ;processed at any one time.  The next EVENT POINTER in the queue will | 
|---|
| 68 | ;not be processed if SCLIMIT is exceeded.  SCLIMIT is not an absolute | 
|---|
| 69 | ;limit, since a single EVENT POINTER can generate multiple HL7 | 
|---|
| 70 | ;messages. | 
|---|
| 71 | ;Sites can modify SCLIMIT by editing the HL7 TRANSMIT LIMIT field of | 
|---|
| 72 | ;the PCMM PARAMETER file. | 
|---|
| 73 | ; | 
|---|
| 74 | NEW SCLIMIT,WORK,VARPTR | 
|---|
| 75 | S SCLIMIT=$P($G(^SCTM(404.44,1,1)),U,5) ;Limit # of msgs processed | 
|---|
| 76 | S:'SCLIMIT SCLIMIT=2500 ;Default to 2500 msgs | 
|---|
| 77 | S VARPTR="" | 
|---|
| 78 | F  S VARPTR=$O(^SCPT(404.48,"AACXMIT",VARPTR)) Q:VARPTR=""!(SCLIMIT<1)  D | 
|---|
| 79 | . KILL @XMITARRY ;Initialize array | 
|---|
| 80 | . ; | 
|---|
| 81 | . ;Preserve the Event IEN. Used to process a deletion. | 
|---|
| 82 | . F SCEVIEN=0:0 S SCEVIEN=$O(^SCPT(404.48,"AACXMIT",VARPTR,SCEVIEN)) Q:'SCEVIEN  D | 
|---|
| 83 | .. ; | 
|---|
| 84 | .. ;Build segment array | 
|---|
| 85 | .. K SCFUT | 
|---|
| 86 | .. S WORK=+$P($G(^SCPT(404.48,SCEVIEN,0)),U,8) | 
|---|
| 87 | .. I WORK N HLEID S HLEID=$$HLEIDW() S RESULT=$$BUILD^SCMCHLP(VARPTR,.HL,.XMITARRY,SCEVIEN) | 
|---|
| 88 | .. I 'WORK S RESULT=$$BUILD^SCMCHLB(VARPTR,.HL,.XMITARRY) | 
|---|
| 89 | .. I +RESULT<0 D  Q  ;Error occurred when building segment array | 
|---|
| 90 | .. . S @XMITERR@(VARPTR)=$P(RESULT,"^",2) | 
|---|
| 91 | .. ; | 
|---|
| 92 | .. ;If in Review mode, display info and Quit. | 
|---|
| 93 | .. I MODE=2 D  Q  ; | 
|---|
| 94 | .. . W !,VARPTR_"  "_$S('$D(@XMITARRY):"No ",1:"")_"Data Found" | 
|---|
| 95 | .. ; | 
|---|
| 96 | .. ;If no segments built, turn off transmission flag and Quit. | 
|---|
| 97 | .. I '$D(@XMITARRY) D:'$G(SCFUT) FLAG(VARPTR,SCEVIEN) Q | 
|---|
| 98 | .. ; | 
|---|
| 99 | .. ;Generate message. | 
|---|
| 100 | .. ; | 
|---|
| 101 | .. Q:'$$GENERATE^SCMCHLG()  ;^SCMCHLG Increments MSGCNT | 
|---|
| 102 | .. D:'$G(SCFUT) FLAG(VARPTR,SCEVIEN) ;Turn off transmission flag | 
|---|
| 103 | .. K @XMITARRY  ;clean up variables | 
|---|
| 104 | . ; | 
|---|
| 105 | . Q | 
|---|
| 106 | ; | 
|---|
| 107 | I '$D(ZTQUEUED) W !,MSGCNT," messages sent." | 
|---|
| 108 | ; | 
|---|
| 109 | ;Send completion bulletin and clean up arrays. | 
|---|
| 110 | I MODE=1 D  ;Don't do this if in DISPLAY mode. | 
|---|
| 111 | . S ERRCNT=$$COUNT^SCMCHLS(XMITERR) | 
|---|
| 112 | . D CMPLBULL^SCMCHLM(MSGCNT,ERRCNT,XMITERR) | 
|---|
| 113 | . KILL @XMITARRY,@XMITERR | 
|---|
| 114 | . K ^XTMP("SCMCHL") | 
|---|
| 115 | ; | 
|---|
| 116 | Q:SCLIMIT<1 | 
|---|
| 117 | ; | 
|---|
| 118 | ;alb/rpm;Patch 224;Transmit "M"arked messages from Transmission Log | 
|---|
| 119 | D EN^SCMCHLRR(.SCLIMIT) | 
|---|
| 120 | Q:SCLIMIT<1 | 
|---|
| 121 | ; | 
|---|
| 122 | ;alb/rpm;Patch224;Transmit messages with overdue ACKnowledgment | 
|---|
| 123 | D AUTO^SCMCHLRR(.SCLIMIT) | 
|---|
| 124 | Q | 
|---|
| 125 | ; | 
|---|
| 126 | MANUAL ;User passed in a specific variable pointer value. This value will | 
|---|
| 127 | ;be used rather than $ORDERing thru "AACXMIT" xref. | 
|---|
| 128 | ; | 
|---|
| 129 | NEW SCMANUAL | 
|---|
| 130 | S SCMANUAL=1 ;Indicates variable pointer was manually entered. | 
|---|
| 131 | ;             A delete cannot be processed. | 
|---|
| 132 | ; | 
|---|
| 133 | ;Initialize array | 
|---|
| 134 | KILL @XMITARRY | 
|---|
| 135 | ; | 
|---|
| 136 | ;Build segment array | 
|---|
| 137 | I $G(WORK) N HLEID S HLEID=$$HLEIDW() S RESULT=$$BUILD^SCMCHLP(VARPTR,.HL,.XMITARRY) | 
|---|
| 138 | I '$G(WORK) S RESULT=$$BUILD^SCMCHLB(VARPTR,.HL,.XMITARRY) | 
|---|
| 139 | I +RESULT<0 D  Q  ;Error occurred when building segment array | 
|---|
| 140 | . S @XMITERR@(VARPTR)=$P(RESULT,"^",2) | 
|---|
| 141 | W !,VARPTR_"  "_$S('$D(@XMITARRY):"No ",1:"")_"Data Found",! | 
|---|
| 142 | ; | 
|---|
| 143 | ;Generate message - FOR TESTING PURPOSES ONLY! | 
|---|
| 144 | S RESULT=$$GENERATE^SCMCHLG() | 
|---|
| 145 | K ^XTMP("SCMCHL") | 
|---|
| 146 | Q | 
|---|
| 147 | ; | 
|---|
| 148 | FLAG(VARPTR,SCEVIEN) ;Turn off transmission flag. This removes event from "AACXMIT" | 
|---|
| 149 | ;xref in PCMM HL7 EVENT file. | 
|---|
| 150 | ;Input: | 
|---|
| 151 | ;   VARPTR - Internal value of EVENT POINTER field | 
|---|
| 152 | ; | 
|---|
| 153 | Q:$G(VARPTR)']"" | 
|---|
| 154 | I $G(SCEVIEN) D TRANSMIT^SCMCHLE(SCEVIEN,0) Q | 
|---|
| 155 | NEW IEN | 
|---|
| 156 | S IEN=0 | 
|---|
| 157 | F  S IEN=$O(^SCPT(404.48,"AACXMIT",VARPTR,IEN)) Q:'IEN  D  ; | 
|---|
| 158 | . D TRANSMIT^SCMCHLE(IEN,0) | 
|---|
| 159 | Q | 
|---|
| 160 | ; | 
|---|
| 161 | HLEIDW() ;Return workload sending event | 
|---|
| 162 | Q +$O(^ORD(101,"B","SCMC SEND SERVER WORKLOAD",0)) | 
|---|
| 163 | HLEID() ;Return pointer to sending event | 
|---|
| 164 | I $G(WORK) Q $$HLEIDW() | 
|---|
| 165 | Q +$O(^ORD(101,"B","PCMM SEND SERVER FOR ADT-A08",0)) | 
|---|
| 166 | Q | 
|---|