- SCMCHL ;BP/DJB - PCMM HL7 Main Calling Point ; 16 Dec 2002 11:14 AM
- ;;5.3;Scheduling;**177,204,224,272,367**;AUG 13, 1993
- ;
- ;Reference routine: SCDXMSG
- MAIN(MODE,XMITARRY,VARPTR,WORK) ;Main entry point to generate Primary Care HL7
- ;messages to NPCD in Austin. Loop thru PCMM HL7 EVENT file (#404.48)
- ;and generate HL7 message for each appropriate event.
- ;
- ;Input:
- ; MODE - Mode of operation.
- ; 1: Generate mode - Generate HL7 messages. (Default).
- ; 2: Review mode - HL7 segments will be built in array
- ; XMITARRY and may be reviewed. HL7
- ; messages WILL NOT be generated, and
- ; processed events will not be
- ; removed from the transmit xref in
- ; PCMM HL7 EVENT file.
- ; XMITARRY - Array to store HL7 segments (full global ref).
- ; Default=^TMP("PCMM","HL7",$J)
- ; VARPTR - For testing purposes, you may pass in an EVENT POINTER
- ; value. This value will be used rather than $ORDERing
- ; thru "AACXMIT" xref in PCMM HL7 EVENT file.
- ; Examples:
- ; "2290;SCPT(404.43," (Patient Team Position Assign)
- ; "725;SCTM(404.52," (Position Assign History)
- ; "1;SCTM(404.53," (Preceptor Assign History)
- ; Work Optional if present
- ;Output: None
- ;
- ;Prevent multiple runs processing at the same time.
- I $G(VARPTR)'="",$D(^XTMP("SCMCHL")) D Q
- .W !,"HL7 Transmission in progress, no testing allowed!",!
- I $D(^XTMP("SCMCHL")) D Q
- .W !,"HL7 Transmission in progress, please try again later.",!
- S ^XTMP("SCMCHL",0)=DT_"^"_DT
- ;
- NEW ERRCNT,IEN,MSG,MSGCNT,RESULT
- NEW SCEVIEN,SCFAC
- NEW HL,HLECH,HLEID,HLFS,HLQ,HLP,XMITERR
- ;
- ;Initialize variables - set global locations
- S:$G(MODE)'=2 MODE=1 ;Default mode = "Generate"
- S:$G(XMITARRY)="" XMITARRY="^TMP(""PCMM"",""HL7"","_$J_")" ;Segments
- S XMITERR="^TMP(""PCMM"",""ERR"","_$J_")" ;Errors
- S MSGCNT=0
- ;
- ;Get pointer to sending event
- S HLEID=$$HLEID()
- I 'HLEID D Q
- . S MSG="Unable to initialize HL7 variables - protocol not found"
- . D ERRBULL^SCMCHLM(MSG)
- ;
- ;Initialize HL7 variables
- D INIT^HLFNC2(HLEID,.HL)
- I $O(HL(""))="" D Q
- . D ERRBULL^SCMCHLM($P(HL,"^",2))
- ;
- ;Get faciltiy number
- S SCFAC=+$P($$SITE^VASITE(),"^",3)
- ;
- ;User passed in an EVENT POINTER value
- I $G(VARPTR)]"" D MANUAL Q
- ;
- LOOP ;Loop thru EVENT POINTER xref and send message for each unique one.
- ;alb/rpm Patch 224
- ;The SCLIMIT counter allows sites to limit the number of HL7 messages
- ;processed at any one time. The next EVENT POINTER in the queue will
- ;not be processed if SCLIMIT is exceeded. SCLIMIT is not an absolute
- ;limit, since a single EVENT POINTER can generate multiple HL7
- ;messages.
- ;Sites can modify SCLIMIT by editing the HL7 TRANSMIT LIMIT field of
- ;the PCMM PARAMETER file.
- ;
- NEW SCLIMIT,WORK,VARPTR
- S SCLIMIT=$P($G(^SCTM(404.44,1,1)),U,5) ;Limit # of msgs processed
- S:'SCLIMIT SCLIMIT=2500 ;Default to 2500 msgs
- S VARPTR=""
- F S VARPTR=$O(^SCPT(404.48,"AACXMIT",VARPTR)) Q:VARPTR=""!(SCLIMIT<1) D
- . KILL @XMITARRY ;Initialize array
- . ;
- . ;Preserve the Event IEN. Used to process a deletion.
- . F SCEVIEN=0:0 S SCEVIEN=$O(^SCPT(404.48,"AACXMIT",VARPTR,SCEVIEN)) Q:'SCEVIEN D
- .. ;
- .. ;Build segment array
- .. K SCFUT
- .. S WORK=+$P($G(^SCPT(404.48,SCEVIEN,0)),U,8)
- .. I WORK N HLEID S HLEID=$$HLEIDW() S RESULT=$$BUILD^SCMCHLP(VARPTR,.HL,.XMITARRY,SCEVIEN)
- .. I 'WORK S RESULT=$$BUILD^SCMCHLB(VARPTR,.HL,.XMITARRY)
- .. I +RESULT<0 D Q ;Error occurred when building segment array
- .. . S @XMITERR@(VARPTR)=$P(RESULT,"^",2)
- .. ;
- .. ;If in Review mode, display info and Quit.
- .. I MODE=2 D Q ;
- .. . W !,VARPTR_" "_$S('$D(@XMITARRY):"No ",1:"")_"Data Found"
- .. ;
- .. ;If no segments built, turn off transmission flag and Quit.
- .. I '$D(@XMITARRY) D:'$G(SCFUT) FLAG(VARPTR,SCEVIEN) Q
- .. ;
- .. ;Generate message.
- .. ;
- .. Q:'$$GENERATE^SCMCHLG() ;^SCMCHLG Increments MSGCNT
- .. D:'$G(SCFUT) FLAG(VARPTR,SCEVIEN) ;Turn off transmission flag
- .. K @XMITARRY ;clean up variables
- . ;
- . Q
- ;
- I '$D(ZTQUEUED) W !,MSGCNT," messages sent."
- ;
- ;Send completion bulletin and clean up arrays.
- I MODE=1 D ;Don't do this if in DISPLAY mode.
- . S ERRCNT=$$COUNT^SCMCHLS(XMITERR)
- . D CMPLBULL^SCMCHLM(MSGCNT,ERRCNT,XMITERR)
- . KILL @XMITARRY,@XMITERR
- . K ^XTMP("SCMCHL")
- ;
- Q:SCLIMIT<1
- ;
- ;alb/rpm;Patch 224;Transmit "M"arked messages from Transmission Log
- D EN^SCMCHLRR(.SCLIMIT)
- Q:SCLIMIT<1
- ;
- ;alb/rpm;Patch224;Transmit messages with overdue ACKnowledgment
- D AUTO^SCMCHLRR(.SCLIMIT)
- Q
- ;
- MANUAL ;User passed in a specific variable pointer value. This value will
- ;be used rather than $ORDERing thru "AACXMIT" xref.
- ;
- NEW SCMANUAL
- S SCMANUAL=1 ;Indicates variable pointer was manually entered.
- ; A delete cannot be processed.
- ;
- ;Initialize array
- KILL @XMITARRY
- ;
- ;Build segment array
- I $G(WORK) N HLEID S HLEID=$$HLEIDW() S RESULT=$$BUILD^SCMCHLP(VARPTR,.HL,.XMITARRY)
- I '$G(WORK) S RESULT=$$BUILD^SCMCHLB(VARPTR,.HL,.XMITARRY)
- I +RESULT<0 D Q ;Error occurred when building segment array
- . S @XMITERR@(VARPTR)=$P(RESULT,"^",2)
- W !,VARPTR_" "_$S('$D(@XMITARRY):"No ",1:"")_"Data Found",!
- ;
- ;Generate message - FOR TESTING PURPOSES ONLY!
- S RESULT=$$GENERATE^SCMCHLG()
- K ^XTMP("SCMCHL")
- Q
- ;
- FLAG(VARPTR,SCEVIEN) ;Turn off transmission flag. This removes event from "AACXMIT"
- ;xref in PCMM HL7 EVENT file.
- ;Input:
- ; VARPTR - Internal value of EVENT POINTER field
- ;
- Q:$G(VARPTR)']""
- I $G(SCEVIEN) D TRANSMIT^SCMCHLE(SCEVIEN,0) Q
- NEW IEN
- S IEN=0
- F S IEN=$O(^SCPT(404.48,"AACXMIT",VARPTR,IEN)) Q:'IEN D ;
- . D TRANSMIT^SCMCHLE(IEN,0)
- Q
- ;
- HLEIDW() ;Return workload sending event
- Q +$O(^ORD(101,"B","SCMC SEND SERVER WORKLOAD",0))
- HLEID() ;Return pointer to sending event
- I $G(WORK) Q $$HLEIDW()
- Q +$O(^ORD(101,"B","PCMM SEND SERVER FOR ADT-A08",0))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCHL 6160 printed Jan 18, 2025@03:41:29 Page 2
- SCMCHL ;BP/DJB - PCMM HL7 Main Calling Point ; 16 Dec 2002 11:14 AM
- +1 ;;5.3;Scheduling;**177,204,224,272,367**;AUG 13, 1993
- +2 ;
- +3 ;Reference routine: SCDXMSG
- MAIN(MODE,XMITARRY,VARPTR,WORK) ;Main entry point to generate Primary Care HL7
- +1 ;messages to NPCD in Austin. Loop thru PCMM HL7 EVENT file (#404.48)
- +2 ;and generate HL7 message for each appropriate event.
- +3 ;
- +4 ;Input:
- +5 ; MODE - Mode of operation.
- +6 ; 1: Generate mode - Generate HL7 messages. (Default).
- +7 ; 2: Review mode - HL7 segments will be built in array
- +8 ; XMITARRY and may be reviewed. HL7
- +9 ; messages WILL NOT be generated, and
- +10 ; processed events will not be
- +11 ; removed from the transmit xref in
- +12 ; PCMM HL7 EVENT file.
- +13 ; XMITARRY - Array to store HL7 segments (full global ref).
- +14 ; Default=^TMP("PCMM","HL7",$J)
- +15 ; VARPTR - For testing purposes, you may pass in an EVENT POINTER
- +16 ; value. This value will be used rather than $ORDERing
- +17 ; thru "AACXMIT" xref in PCMM HL7 EVENT file.
- +18 ; Examples:
- +19 ; "2290;SCPT(404.43," (Patient Team Position Assign)
- +20 ; "725;SCTM(404.52," (Position Assign History)
- +21 ; "1;SCTM(404.53," (Preceptor Assign History)
- +22 ; Work Optional if present
- +23 ;Output: None
- +24 ;
- +25 ;Prevent multiple runs processing at the same time.
- +26 IF $GET(VARPTR)'=""
- IF $DATA(^XTMP("SCMCHL"))
- Begin DoDot:1
- +27 WRITE !,"HL7 Transmission in progress, no testing allowed!",!
- End DoDot:1
- QUIT
- +28 IF $DATA(^XTMP("SCMCHL"))
- Begin DoDot:1
- +29 WRITE !,"HL7 Transmission in progress, please try again later.",!
- End DoDot:1
- QUIT
- +30 SET ^XTMP("SCMCHL",0)=DT_"^"_DT
- +31 ;
- +32 NEW ERRCNT,IEN,MSG,MSGCNT,RESULT
- +33 NEW SCEVIEN,SCFAC
- +34 NEW HL,HLECH,HLEID,HLFS,HLQ,HLP,XMITERR
- +35 ;
- +36 ;Initialize variables - set global locations
- +37 ;Default mode = "Generate"
- if $GET(MODE)'=2
- SET MODE=1
- +38 ;Segments
- if $GET(XMITARRY)=""
- SET XMITARRY="^TMP(""PCMM"",""HL7"","_$JOB_")"
- +39 ;Errors
- SET XMITERR="^TMP(""PCMM"",""ERR"","_$JOB_")"
- +40 SET MSGCNT=0
- +41 ;
- +42 ;Get pointer to sending event
- +43 SET HLEID=$$HLEID()
- +44 IF 'HLEID
- Begin DoDot:1
- +45 SET MSG="Unable to initialize HL7 variables - protocol not found"
- +46 DO ERRBULL^SCMCHLM(MSG)
- End DoDot:1
- QUIT
- +47 ;
- +48 ;Initialize HL7 variables
- +49 DO INIT^HLFNC2(HLEID,.HL)
- +50 IF $ORDER(HL(""))=""
- Begin DoDot:1
- +51 DO ERRBULL^SCMCHLM($PIECE(HL,"^",2))
- End DoDot:1
- QUIT
- +52 ;
- +53 ;Get faciltiy number
- +54 SET SCFAC=+$PIECE($$SITE^VASITE(),"^",3)
- +55 ;
- +56 ;User passed in an EVENT POINTER value
- +57 IF $GET(VARPTR)]""
- DO MANUAL
- QUIT
- +58 ;
- LOOP ;Loop thru EVENT POINTER xref and send message for each unique one.
- +1 ;alb/rpm Patch 224
- +2 ;The SCLIMIT counter allows sites to limit the number of HL7 messages
- +3 ;processed at any one time. The next EVENT POINTER in the queue will
- +4 ;not be processed if SCLIMIT is exceeded. SCLIMIT is not an absolute
- +5 ;limit, since a single EVENT POINTER can generate multiple HL7
- +6 ;messages.
- +7 ;Sites can modify SCLIMIT by editing the HL7 TRANSMIT LIMIT field of
- +8 ;the PCMM PARAMETER file.
- +9 ;
- +10 NEW SCLIMIT,WORK,VARPTR
- +11 ;Limit # of msgs processed
- SET SCLIMIT=$PIECE($GET(^SCTM(404.44,1,1)),U,5)
- +12 ;Default to 2500 msgs
- if 'SCLIMIT
- SET SCLIMIT=2500
- +13 SET VARPTR=""
- +14 FOR
- SET VARPTR=$ORDER(^SCPT(404.48,"AACXMIT",VARPTR))
- if VARPTR=""!(SCLIMIT<1)
- QUIT
- Begin DoDot:1
- +15 ;Initialize array
- KILL @XMITARRY
- +16 ;
- +17 ;Preserve the Event IEN. Used to process a deletion.
- +18 FOR SCEVIEN=0:0
- SET SCEVIEN=$ORDER(^SCPT(404.48,"AACXMIT",VARPTR,SCEVIEN))
- if 'SCEVIEN
- QUIT
- Begin DoDot:2
- +19 ;
- +20 ;Build segment array
- +21 KILL SCFUT
- +22 SET WORK=+$PIECE($GET(^SCPT(404.48,SCEVIEN,0)),U,8)
- +23 IF WORK
- NEW HLEID
- SET HLEID=$$HLEIDW()
- SET RESULT=$$BUILD^SCMCHLP(VARPTR,.HL,.XMITARRY,SCEVIEN)
- +24 IF 'WORK
- SET RESULT=$$BUILD^SCMCHLB(VARPTR,.HL,.XMITARRY)
- +25 ;Error occurred when building segment array
- IF +RESULT<0
- Begin DoDot:3
- +26 SET @XMITERR@(VARPTR)=$PIECE(RESULT,"^",2)
- End DoDot:3
- QUIT
- +27 ;
- +28 ;If in Review mode, display info and Quit.
- +29 ;
- IF MODE=2
- Begin DoDot:3
- +30 WRITE !,VARPTR_" "_$SELECT('$DATA(@XMITARRY):"No ",1:"")_"Data Found"
- End DoDot:3
- QUIT
- +31 ;
- +32 ;If no segments built, turn off transmission flag and Quit.
- +33 IF '$DATA(@XMITARRY)
- if '$GET(SCFUT)
- DO FLAG(VARPTR,SCEVIEN)
- QUIT
- +34 ;
- +35 ;Generate message.
- +36 ;
- +37 ;^SCMCHLG Increments MSGCNT
- if '$$GENERATE^SCMCHLG()
- QUIT
- +38 ;Turn off transmission flag
- if '$GET(SCFUT)
- DO FLAG(VARPTR,SCEVIEN)
- +39 ;clean up variables
- KILL @XMITARRY
- End DoDot:2
- +40 ;
- +41 QUIT
- End DoDot:1
- +42 ;
- +43 IF '$DATA(ZTQUEUED)
- WRITE !,MSGCNT," messages sent."
- +44 ;
- +45 ;Send completion bulletin and clean up arrays.
- +46 ;Don't do this if in DISPLAY mode.
- IF MODE=1
- Begin DoDot:1
- +47 SET ERRCNT=$$COUNT^SCMCHLS(XMITERR)
- +48 DO CMPLBULL^SCMCHLM(MSGCNT,ERRCNT,XMITERR)
- +49 KILL @XMITARRY,@XMITERR
- +50 KILL ^XTMP("SCMCHL")
- End DoDot:1
- +51 ;
- +52 if SCLIMIT<1
- QUIT
- +53 ;
- +54 ;alb/rpm;Patch 224;Transmit "M"arked messages from Transmission Log
- +55 DO EN^SCMCHLRR(.SCLIMIT)
- +56 if SCLIMIT<1
- QUIT
- +57 ;
- +58 ;alb/rpm;Patch224;Transmit messages with overdue ACKnowledgment
- +59 DO AUTO^SCMCHLRR(.SCLIMIT)
- +60 QUIT
- +61 ;
- MANUAL ;User passed in a specific variable pointer value. This value will
- +1 ;be used rather than $ORDERing thru "AACXMIT" xref.
- +2 ;
- +3 NEW SCMANUAL
- +4 ;Indicates variable pointer was manually entered.
- SET SCMANUAL=1
- +5 ; A delete cannot be processed.
- +6 ;
- +7 ;Initialize array
- +8 KILL @XMITARRY
- +9 ;
- +10 ;Build segment array
- +11 IF $GET(WORK)
- NEW HLEID
- SET HLEID=$$HLEIDW()
- SET RESULT=$$BUILD^SCMCHLP(VARPTR,.HL,.XMITARRY)
- +12 IF '$GET(WORK)
- SET RESULT=$$BUILD^SCMCHLB(VARPTR,.HL,.XMITARRY)
- +13 ;Error occurred when building segment array
- IF +RESULT<0
- Begin DoDot:1
- +14 SET @XMITERR@(VARPTR)=$PIECE(RESULT,"^",2)
- End DoDot:1
- QUIT
- +15 WRITE !,VARPTR_" "_$SELECT('$DATA(@XMITARRY):"No ",1:"")_"Data Found",!
- +16 ;
- +17 ;Generate message - FOR TESTING PURPOSES ONLY!
- +18 SET RESULT=$$GENERATE^SCMCHLG()
- +19 KILL ^XTMP("SCMCHL")
- +20 QUIT
- +21 ;
- FLAG(VARPTR,SCEVIEN) ;Turn off transmission flag. This removes event from "AACXMIT"
- +1 ;xref in PCMM HL7 EVENT file.
- +2 ;Input:
- +3 ; VARPTR - Internal value of EVENT POINTER field
- +4 ;
- +5 if $GET(VARPTR)']""
- QUIT
- +6 IF $GET(SCEVIEN)
- DO TRANSMIT^SCMCHLE(SCEVIEN,0)
- QUIT
- +7 NEW IEN
- +8 SET IEN=0
- +9 ;
- FOR
- SET IEN=$ORDER(^SCPT(404.48,"AACXMIT",VARPTR,IEN))
- if 'IEN
- QUIT
- Begin DoDot:1
- +10 DO TRANSMIT^SCMCHLE(IEN,0)
- End DoDot:1
- +11 QUIT
- +12 ;
- HLEIDW() ;Return workload sending event
- +1 QUIT +$ORDER(^ORD(101,"B","SCMC SEND SERVER WORKLOAD",0))
- HLEID() ;Return pointer to sending event
- +1 IF $GET(WORK)
- QUIT $$HLEIDW()
- +2 QUIT +$ORDER(^ORD(101,"B","PCMM SEND SERVER FOR ADT-A08",0))
- +3 QUIT