Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDPMHLS

SDPMHLS.m

Go to the documentation of this file. 
  1. SDPMHLS ;BPFO/JRC -Build ROU-R01 HL7 message for 'SD ENC PERF MON' application ; 4/2/04 7:12am [5/12/04 10:29am]
  1.  ;;5.3;Scheduling;**313,371,416,1015**;AUG 13, 1993;Build 21
  1.  ;
  1. QUE ;Queue retroactive XMIT job
  1.  ;Declare variables
  1.  S (STDT,EDT,Y,X)=""
  1.  ;Prompt user for month and year
  1.  S %DT("A")="Please select MONTH and YEAR for TIU's National Rollup to transmit: "
  1.  S %DT="AEMX"
  1.  ;Set %DT not to allow current and future months
  1.  S %DT(0)=-($$FMADD^XLFDT($$NOW^XLFDT(),-32))
  1.  D ^%DT
  1.  ;Check date input if (-1) quit else continue
  1.  I Y<0 Q
  1.  ;Set STDT = user selected month and year and add 1 day
  1.  S STDT=Y+01
  1.  ;Add 32 days to STDT
  1.  S X=$$FMADD^XLFDT(STDT,32)
  1.  ;Subtract number of days that overlap into the following month
  1.  S EDT=$$FMADD^XLFDT(X,-($E(X,6,7)))
  1.  ;Set task variables
  1.  S ZTIO=""
  1.  S ZTDESC="Performance Indicator National Rollup"
  1.  S ZTRTN="EN^SDPMHLS"
  1.  S ZTSAVE("STDT")=""
  1.  S ZTSAVE("EDT")=""
  1.  D ^%ZTLOAD W:$D(ZTSK) "   (Task: ",ZTSK,")"
  1.  K STDT,EDT,X,Y,%DT,%DT("A"),%DT(0)
  1.  Q
  1. EN ;Entry point
  1.  ;Note: Retroactive reports use variables STDT and EDT to pass dates
  1.  ;   STDT - start date, first day of the month for selected month
  1.  ;   EDT - ending date, last day of the month for selected month
  1.  ;Declare variables
  1.  N STDATE,ENDDATE
  1.  N XMTARRY,SCRNARR,SORTARR,OUTARR,X,RDATE
  1.  S SCRNARR="^TMP(""SCRPW"",$J,""SCRNARR"")"
  1.  S SORTARR="^TMP(""SCRPW"",$J,""SORTARR"")"
  1.  S OUTARR="^TMP(""SCRPW"",$J,""OUTARR"")"
  1.  S XMTARRY="^TMP(""HLS"","_$J_")"
  1.  S (STDATE,ENDDATE)=""
  1.  ;Set national screen/sort
  1.  D ROLLUP^SCRPW303(SCRNARR,SORTARR)
  1.  ;Call module to build scratch global
  1.  D GETINFO
  1.  ;Build HL7 Message
  1.  D BLDMSG(OUTARR,XMTARRY)
  1.  ;Send HL7 Message
  1.  I +$O(@XMTARRY@(""))>0 D
  1.  .S J=$$SENDMSG(.XMTARRY)
  1.  ;Send XMIT notifications
  1.  D MSG
  1.  ;Cleanup an quit
  1.  D EXIT
  1.  Q
  1. BLDMSG(OUTARR,XMTARRY) ;Build OBR segment
  1.  ;Input : OUTARR - Ouptut array 
  1.  ;Output: XMTARRY - HL7 temporary array
  1.  ;Declare variables
  1.  N HL,HLFS,HLECH,HLQ,SNODE,PNODE,DIVHL,TYPE,COUNT
  1.  D INIT^HLFNC2("SD ENC PERF MON ORU-R01 SERVER",.HL)
  1.  Q:$O(HL(""))=""
  1.  N VAFEVN,VAFSTR,CNT,MAKE,VAFOBR,VAFOBX,I,XCNT,INFO,DIV,DIVHL
  1.  S CNT=1,XCNT=0
  1.  S MAKE(1)="1"
  1.  S MAKE(4,1,1)="01"
  1.  S MAKE(4,1,2)="VA ENC PERF MONITOR"
  1.  S MAKE(7)=$$HLDATE^HLFNC(RDATE)
  1.  S MAKE(25)="F"
  1.  S MAKE(27,1,4)=$$HLDATE^HLFNC(STDATE,"DT")
  1.  S MAKE(27,1,5)=$$HLDATE^HLFNC(ENDDATE,"DT")
  1.  K VAFOBR
  1.  D MAKEIT^VAFHLU("OBR",.MAKE,.VAFOBR,.VAFOBR)
  1.  M @XMTARRY@(CNT)=VAFOBR
  1.  S XCNT=XCNT+1,CNT=CNT+1
  1.  ;Build OBX segment for facility
  1.  S SNODE=$G(@OUTARR@("SUMMARY"))
  1.  S PNODE=$G(@OUTARR@("SUMMARY","PI"))
  1.  S DIVHL=$P($$SITE^VASITE,"^",3)
  1.  D MAKEOBX
  1.  ;Build OBX segment for division(s)
  1.  S DIV="" F  S DIV=$O(@OUTARR@("SUBTOTAL",DIV)) Q:DIV=""  D
  1.  .N SNODE,PNODE
  1.  .S SNODE=$G(@OUTARR@("SUBTOTAL",DIV))
  1.  .S PNODE=$G(@OUTARR@("SUBTOTAL",DIV,"PI"))
  1.  .S DIVHL=$P(DIV,"^",2)
  1.  .D MAKEOBX
  1.  .Q
  1.  Q
  1. MAKEOBX ;Set type and count for total encounters to bld OBX
  1.  ;Input : SNODE - Temporary counter node for summary
  1.  ;        PNODE - Temporary counter node for PI
  1.  ;        DIVHL - Division and Suffix
  1.  ;        CNT - Temporary array subscript count
  1.  ;        XCNT  - OBX segment counter
  1.  ;        XMTARRY - Temporary HL array ^TMP("HLS",$J)
  1.  S TYPE="CD",COUNT=$P($G(SNODE),U,1),OBID=1 D BLDOBX
  1.  ;Set type and count for counters for ET in days F0 - F10 to bld OBX
  1.  F M4=0:1:10 D
  1.  .S OBID=2
  1.  .S TYPE="F"_M4
  1.  .S COUNT=$P($G(PNODE),U,(M4+1))
  1.  .D BLDOBX
  1.  ;Set type and count for scanned notes and Uniques to bld OBX
  1.  S TYPE="FSPN",OBID=2,COUNT=$P($G(SNODE),U,7) D BLDOBX
  1.  S TYPE="FEP",OBID=2,COUNT=$P($G(SNODE),U,4) D BLDOBX
  1.  S TYPE="FDSS",OBID=2,COUNT=$P($G(SNODE),U,5) D BLDOBX
  1.  ;Set types and count for encounters w/o progress notes and
  1.  ;encounters w/progress notes pending signatures
  1.  S TYPE="FNPN",OBID=2,COUNT=+$P(SNODE,U,1)-(+($P(SNODE,U,2)))-(+($P(SNODE,U,9)))-(+($P(SNODE,U,7)))-(+($P(PNODE,U,11))) D BLDOBX
  1.  S TYPE="FNPS",OBID=2,COUNT=$P($G(SNODE),U,9) D BLDOBX
  1.  Q
  1. BLDOBX ;Build OBX
  1.  ;Ouput : @XMTARRY = Temporary HL array
  1.  ;Set variables
  1.  N MAKE,VAFOBX
  1.  S MAKE(1)=XCNT
  1.  S MAKE(2)="NM"
  1.  S MAKE(3,1,1)=OBID
  1.  S MAKE(3,1,4)=TYPE
  1.  S MAKE(5)=COUNT
  1.  S MAKE(11)="F"
  1.  S MAKE(15)=DIVHL
  1.  K VAFOBX
  1.  D MAKEIT^VAFHLU("OBX",.MAKE,.VAFOBX,.VAFOBX)
  1.  M @XMTARRY@(CNT)=VAFOBX
  1.  S XCNT=XCNT+1,CNT=CNT+1
  1.  Q
  1. SENDMSG(XMTARRY) ;Send HL7 message
  1.  ;Input - @XMTARRY
  1.  ;Output - ARRY4HL7
  1.  N ARRY4HL7,KILLARRY,HL,HLRESLT,HLFS,HLECH,HLQ,HLP
  1.  S XMTARRY=$G(XMTARRY)
  1.  S:'(XMTARRY]"") XMTARRY="^TMP(""HLS"","_$J_")"
  1.  Q:($O(@XMTARRY@(""))="") "-1^Can not send empty message"
  1.  S ARRY4HL7="TMP(""HLS"","_$J_")"
  1.  ;Initialize HL7 variables
  1.  D INIT^HLFNC2("SD ENC PERF MON ORU-R01 SERVER",.HL)
  1.  Q:($O(HL(""))="") "-1^Unable to initialize HL7 variables"
  1.  ;Check if XMTARRY is ^TMP("HLS",$J)
  1.  S KILLARRY=0
  1.  I $NA(@XMTARRY)'=$NA(@ARRY4HL7) D
  1.  .K @ARRY4HL7
  1.  .M @ARRY4HL7=@XMTARRY
  1.  .S KILLARRY=1
  1.  ;Broadcast message
  1.  D GENERATE^HLMA("SD ENC PERF MON ORU-R01 SERVER","GM",1,.HLRESLT,"",.HLP)
  1.  S:('HLRESLT) HLRESLT=$P(HLRESLT,"^",2,3)
  1.  ;Delete ^TMP("HLS",$J) if XMTARRY was different
  1.  K:(KILLARRY) @ARRY4HL7
  1.  Q $G(HLRESLT)
  1. GETINFO ;Get performance monitor data
  1.  ;Input:
  1.  ;    @SCRNARR - Screen array full global reference
  1.  ;    @SORTARR - Sort array full global reference
  1.  ;Output:
  1.  ;    @OUTARR - Ouput array full global reference 
  1.  ;Remember starting time
  1.  S RDATE=$$NOW^XLFDT()
  1.  ;Check STDT and EDT, if 1 set STDATE and ENDDATE
  1.  I $D(STDT)&$D(EDT) S STDATE=STDT,ENDDATE=EDT
  1.  I STDATE="" D
  1.  .;Set start date = 1st day of previous month
  1.  .N X,X1,X2
  1.  .S X1=$$DT^XLFDT(),X2=-30 S:$E(X1,6,7)=31 X2=-31
  1.  .D C^%DTC
  1.  .S STDATE=$E(X,1,5)_"01"
  1.  .;Set end date = start date + 32 minus number of days into next month
  1.  .S X=$$FMADD^XLFDT(STDATE,32)
  1.  .S ENDDATE=$$FMADD^XLFDT(X,-($E(X,6,7)))
  1.  .Q
  1.  ;Set date range in screen array
  1.  S @SCRNARR@("RANGE")=STDATE_"^"_ENDDATE
  1.  ;Get data
  1.  D GETDATA^SDPMUT1(SCRNARR,SORTARR,OUTARR)
  1.  Q
  1. MSG ;Build bulletin and send
  1.  ;Input:
  1.  ;     RDATE - report starting time
  1.  ;Output: 
  1.  ;   Notificaion bulletin to SD ENC PERF MON mail group
  1.  N MSGTEXT,XMTEXT,XMSUB,XMY,XMCHAN,XMZ,XMDUZ
  1.  S MSGTEXT(1)=" "
  1.  S MSGTEXT(2)="Performance Indicator National Rollup was started on "_$$FMTE^XLFDT(RDATE,1)
  1.  S MSGTEXT(3)="Encounter date range: "_$$FMTE^XLFDT(STDATE,1)_" to "_$$FMTE^XLFDT(ENDDATE,1)
  1.  S MSGTEXT(3)="Extraction of data and sending of data completed "_$$FMTE^XLFDT($$NOW^XLFDT(),1)
  1.  S MSGTEXT(4)=" "
  1.  ;Send completion bulletin to current user
  1.  S XMSUB="Performance Indicator National Rollup"
  1.  S XMTEXT="MSGTEXT("
  1.  S XMY("G.SD PM NOTIFICATION TIU")=""
  1.  S XMCHAN=1
  1.  S XMDUZ="Performance Indicator"
  1.  D ^XMD
  1.  Q
  1. EXIT ;Done
  1.  K @SCRNARR,@SORTARR,@OUTARR,@XMTARRY
  1.  Q