LREPISRV ;DALOI/RLM - EPI data server ;11 Oct 2013 9:49 AM
;;5.2;LAB SERVICE;**260,281,421**;Sep 27, 1994;Build 48
; Reference to $$SITE^VASITE supported by IA #10112
; Reference to ^%ZOSF supported by IA #10096
; Reference to $$CODEC^ICDEX supported by IA #5747
; Reference to $$CSI^ICDEX supported by IA #5747
; Reference to ^ORD(101 supported by IA #872
START ;
K ^TMP($J,"LREPDATA")
S LREPST=$P($$SITE^VASITE,"^",2)
;Determine station number
S X=XQSUB X ^%ZOSF("UPPERCASE") S LREPSUB=Y
S ^TMP($J,"LREPDATA",1)=LREPSUB_" triggered at "_LREPST_" by "_XMFROM_" on "_XQDATE
;The first line of the message tells who requested the action and when
S ^TMP($J,"LREPDATA",2)="No"_$S(LREPSUB["REPORT":" report generated",1:"thing done")_" at "_LREPST
;The second line tells when the server is activated and no data can be gathered from the MailMan message.
S LREPLNT=1
I LREPSUB["REPORT" G REPORT
;If the subject contains "REPORT" send a report
EXIT ;If all went well, report that too.
S %H=$H D YMD^%DTC S XMDUN="EPI SYSTEM",XMDUZ=".5",XMSUB=LREPST_" EPI ("_X_%_")",XMTEXT="^TMP($J,""LREPDATA"","
S XMY("G.EPI-SITE@CINCINNATI.DOMAIN.EXT")=""
;S XMY("ANZALDUA,CAROL@VAHVSS.FO-ALBANY.DOMAIN.EXT")="" ;,XMY("CAROL.ANZALDUA@DOMAIN.EXT")=""
D ^XMD
;Mail the errors and successes back to the EPI group at Cincinnati.
K ^TMP($J,"LREPDATA")
K %,%DT,%H,D,DIC,X,XMDUN,XMDUZ,XMER,XMFROM,XMREC,XMRG,XMSUB,XMTEXT,XMY,XMZ,XQDATE,XQSUB,Y,LREPA,LREPB,LREPDA,LREPDA1,LREPDATA,LREPDFN,LREPDM,LREPDOC
K LREPDOM,LREPDTA,LREPED,LREPER,LREPLNT,LREPNM,LREPPT,LREPSD1,LREPSDT,LREPSSN,LREPST,LREPSUB,LREPTC,YSPR,LREPWB,LREPX,ZTQUEUED,ZTSK
K LRCSI,LRICD,LRA,LRCOND,LRDATA,LRFILL,LRI,LRLENGTH,LRPATH,LRPCECNT,LRSPACES,LRTEST
Q
;F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D
REPORT ;send report
S $P(LRFILL," ",256)=""
S LRA=0 F S LRA=$O(^LAB(69.5,LRA)) Q:'LRA D
. S LREPLNT=$G(LREPLNT)+1,^TMP($J,"LREPDATA",LREPLNT)="*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*="
. S LREPLNT=$G(LREPLNT)+1,^TMP($J,"LREPDATA",LREPLNT)="Pathogen Ref# Cy LD Protocol FPTF Active"
. S LRPATH=$G(^LAB(69.5,LRA,0))
. I LRPATH="" S LREPLNT=$G(LREPLNT)+1,^TMP($J,"LREPDATA",LREPLNT)="IEN # "_LRA_" damaged. (NULL)" Q
. I '$P(LRPATH,"^",7) S LREPLNT=$G(LREPLNT)+1,^TMP($J,"LREPDATA",LREPLNT)="IEN # "_LRA_" damaged. (No Protocol)" Q
. S LRDATA=$P(LRPATH,"^")_$E(LRFILL,$L($P(LRPATH,"^")),30)_$J($P(LRPATH,"^",9),4)_$J($P(LRPATH,"^",5),3)_$J($P(LRPATH,"^",3),3)_$J($P(^ORD(101,$P(LRPATH,"^",7),0),"^"),9)_$J($P(LRPATH,"^",8),4)_$J($P(LRPATH,"^",2),4)
. S LREPLNT=$G(LREPLNT)+1,^TMP($J,"LREPDATA",LREPLNT)=LRDATA
. S LREPLNT=$G(LREPLNT)+1,^TMP($J,"LREPDATA",LREPLNT)=" Lab Test Indicator Value"
LTEST . S LRI=0 F S LRI=$O(^LAB(69.5,LRA,1,LRI)) Q:'LRI D
. . S LRTEST=$G(^LAB(69.5,LRA,1,LRI,0))
. . I $P(LRTEST,"^")="" S LREPLNT=$G(LREPLNT)+1,^TMP($J,"LREPDATA",LREPLNT)="IEN # "_LRA_" damaged. (No Test)" Q
. . S LRCOND=$P(LRTEST,"^",2),LRCOND=$S(LRCOND=1:"Ref. Range",LRCOND=2:"Contains",LRCOND=3:"Greater Than",LRCOND=4:"Less Than",LRCOND=5:"Equal To",1:"Unknown")
. . S LRDATA=$P($G(^LAB(60,$P(LRTEST,"^"),0),0),"^")_$E(LRFILL,$L($P($G(^LAB(60,$P(LRTEST,"^"),0),0),"^")),40)_$J(LRCOND,20)_$J($P(LRTEST,"^",3),10)
. . S LREPLNT=$G(LREPLNT)+1,^TMP($J,"LREPDATA",LREPLNT)=LRDATA
. S LREPLNT=$G(LREPLNT)+1,^TMP($J,"LREPDATA",LREPLNT)=" Etiology"
ETIO . S LRI=0 F S LRI=$O(^LAB(69.5,LRA,2,LRI)) Q:'LRI D
. . S LRTEST=$G(^LAB(69.5,LRA,2,LRI,0))
. . I $P(LRTEST,"^")="" S LREPLNT=$G(LREPLNT)+1,^TMP($J,"LREPDATA",LREPLNT)="IEN # "_LRA_" damaged. (No Etiology)" Q
. . S LRCOND=$P(LRTEST,"^",2),LRCOND=$S(LRCOND=1:"Ref. Range",LRCOND=2:"Contains",LRCOND=3:"Greater Than",LRCOND=4:"Less Than",LRCOND=5:"Equal To",1:"Unknown")
. . S LRDATA=$P($G(^LAB(61.2,$P(LRTEST,"^"),0),0),"^")
. . S LREPLNT=$G(LREPLNT)+1,^TMP($J,"LREPDATA",LREPLNT)=LRDATA
. S LREPLNT=$G(LREPLNT)+1,^TMP($J,"LREPDATA",LREPLNT)=" ICD"
ICD . S LRI=0 F S LRI=$O(^LAB(69.5,LRA,3,LRI)) Q:'LRI D
. . S LRICD=$G(^LAB(69.5,LRA,3,LRI,0))
. . I $P(LRICD,"^")="" S LREPLNT=$G(LREPLNT)+1,^TMP($J,"LREPDATA",LREPLNT)="IEN # "_LRA_" damaged. (No ICD)" Q
. . S LRDATA=$$CODEC^ICDEX(80,$P(LRICD,"^"))
. . S LRCSI=$$CSI^ICDEX(80,$P(LRICD,"^"))
. . S LRLENGTH=11-$L(LRDATA),LRSPACES=""
. . F LRPCECNT=1:1:LRLENGTH S LRSPACES=LRSPACES_" "
. . S LRDATA=LRDATA_LRSPACES_"(ICD-"_$S(LRCSI=30:"10",1:"9")_")"
. . S LREPLNT=$G(LREPLNT)+1,^TMP($J,"LREPDATA",LREPLNT)=LRDATA
. S LREPLNT=$G(LREPLNT)+1,^TMP($J,"LREPDATA",LREPLNT)=" Microbial Susceptibility Indicator Value"
MICROB . S LRI=0 F S LRI=$O(^LAB(69.5,LRA,4,LRI)) Q:'LRI D
. . S LRTEST=$G(^LAB(69.5,LRA,4,LRI,0))
. . I $P(LRTEST,"^")="" S LREPLNT=$G(LREPLNT)+1,^TMP($J,"LREPDATA",LREPLNT)="IEN # "_LRA_" damaged. (No Microbial Susceptibility)" Q
. . S LRCOND=$P(LRTEST,"^",2),LRCOND=$S(LRCOND=1:"Contains",LRCOND=2:"Greater Than",LRCOND=3:"Less Than",LRCOND=4:"Equal To",1:"Unknown")
. . S LRDATA=" "_$P($G(^LAB(62.06,$P(LRTEST,"^"),0),0),"^")_$E(LRFILL,$L($P($G(^LAB(62.06,$P(LRTEST,"^"),0),0),"^")),33)_$J(LRCOND,20)_$J($P(LRTEST,"^",3),11)
. . S LREPLNT=$G(LREPLNT)+1,^TMP($J,"LREPDATA",LREPLNT)=LRDATA
G EXIT
OUT S LREPLNT=$G(LREPLNT)+1,^TMP($J,"LREPDATA",LREPLNT)=XMRG_LREPER_LREPST Q
;Build the text for the return message here.
ZEOR ;LREPISRV
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREPISRV 5497 printed Dec 13, 2024@02:14:36 Page 2
LREPISRV ;DALOI/RLM - EPI data server ;11 Oct 2013 9:49 AM
+1 ;;5.2;LAB SERVICE;**260,281,421**;Sep 27, 1994;Build 48
+2 ; Reference to $$SITE^VASITE supported by IA #10112
+3 ; Reference to ^%ZOSF supported by IA #10096
+4 ; Reference to $$CODEC^ICDEX supported by IA #5747
+5 ; Reference to $$CSI^ICDEX supported by IA #5747
+6 ; Reference to ^ORD(101 supported by IA #872
START ;
+1 KILL ^TMP($JOB,"LREPDATA")
+2 SET LREPST=$PIECE($$SITE^VASITE,"^",2)
+3 ;Determine station number
+4 SET X=XQSUB
XECUTE ^%ZOSF("UPPERCASE")
SET LREPSUB=Y
+5 SET ^TMP($JOB,"LREPDATA",1)=LREPSUB_" triggered at "_LREPST_" by "_XMFROM_" on "_XQDATE
+6 ;The first line of the message tells who requested the action and when
+7 SET ^TMP($JOB,"LREPDATA",2)="No"_$SELECT(LREPSUB["REPORT":" report generated",1:"thing done")_" at "_LREPST
+8 ;The second line tells when the server is activated and no data can be gathered from the MailMan message.
+9 SET LREPLNT=1
+10 IF LREPSUB["REPORT"
GOTO REPORT
+11 ;If the subject contains "REPORT" send a report
EXIT ;If all went well, report that too.
+1 SET %H=$HOROLOG
DO YMD^%DTC
SET XMDUN="EPI SYSTEM"
SET XMDUZ=".5"
SET XMSUB=LREPST_" EPI ("_X_%_")"
SET XMTEXT="^TMP($J,""LREPDATA"","
+2 SET XMY("G.EPI-SITE@CINCINNATI.DOMAIN.EXT")=""
+3 ;S XMY("ANZALDUA,CAROL@VAHVSS.FO-ALBANY.DOMAIN.EXT")="" ;,XMY("CAROL.ANZALDUA@DOMAIN.EXT")=""
+4 DO ^XMD
+5 ;Mail the errors and successes back to the EPI group at Cincinnati.
+6 KILL ^TMP($JOB,"LREPDATA")
+7 KILL %,%DT,%H,D,DIC,X,XMDUN,XMDUZ,XMER,XMFROM,XMREC,XMRG,XMSUB,XMTEXT,XMY,XMZ,XQDATE,XQSUB,Y,LREPA,LREPB,LREPDA,LREPDA1,LREPDATA,LREPDFN,LREPDM,LREPDOC
+8 KILL LREPDOM,LREPDTA,LREPED,LREPER,LREPLNT,LREPNM,LREPPT,LREPSD1,LREPSDT,LREPSSN,LREPST,LREPSUB,LREPTC,YSPR,LREPWB,LREPX,ZTQUEUED,ZTSK
+9 KILL LRCSI,LRICD,LRA,LRCOND,LRDATA,LRFILL,LRI,LRLENGTH,LRPATH,LRPCECNT,LRSPACES,LRTEST
+10 QUIT
+11 ;F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D
REPORT ;send report
+1 SET $PIECE(LRFILL," ",256)=""
+2 SET LRA=0
FOR
SET LRA=$ORDER(^LAB(69.5,LRA))
if 'LRA
QUIT
Begin DoDot:1
+3 SET LREPLNT=$GET(LREPLNT)+1
SET ^TMP($JOB,"LREPDATA",LREPLNT)="*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*="
+4 SET LREPLNT=$GET(LREPLNT)+1
SET ^TMP($JOB,"LREPDATA",LREPLNT)="Pathogen Ref# Cy LD Protocol FPTF Active"
+5 SET LRPATH=$GET(^LAB(69.5,LRA,0))
+6 IF LRPATH=""
SET LREPLNT=$GET(LREPLNT)+1
SET ^TMP($JOB,"LREPDATA",LREPLNT)="IEN # "_LRA_" damaged. (NULL)"
QUIT
+7 IF '$PIECE(LRPATH,"^",7)
SET LREPLNT=$GET(LREPLNT)+1
SET ^TMP($JOB,"LREPDATA",LREPLNT)="IEN # "_LRA_" damaged. (No Protocol)"
QUIT
+8 SET LRDATA=$PIECE(LRPATH,"^")_$EXTRACT(LRFILL,$LENGTH($PIECE(LRPATH,"^")),30)_$JUSTIFY($PIECE(LRPATH,"^",9),4)_$JUSTIFY(...
... $PIECE(LRPATH,"^",5),3)_$JUSTIFY($PIECE(LRPATH,"^",3),3)_$JUSTIFY($PIECE(^ORD(101,$PIECE(LRPATH,"^",7),0),"^"),9)_$JUSTIFY($PIECE(LRPATH,"^",8),4)_$JUSTIFY($PIECE(LRPATH,"^",2),4)
+9 SET LREPLNT=$GET(LREPLNT)+1
SET ^TMP($JOB,"LREPDATA",LREPLNT)=LRDATA
+10 SET LREPLNT=$GET(LREPLNT)+1
SET ^TMP($JOB,"LREPDATA",LREPLNT)=" Lab Test Indicator Value"
LTEST SET LRI=0
FOR
SET LRI=$ORDER(^LAB(69.5,LRA,1,LRI))
if 'LRI
QUIT
Begin DoDot:2
+1 SET LRTEST=$GET(^LAB(69.5,LRA,1,LRI,0))
+2 IF $PIECE(LRTEST,"^")=""
SET LREPLNT=$GET(LREPLNT)+1
SET ^TMP($JOB,"LREPDATA",LREPLNT)="IEN # "_LRA_" damaged. (No Test)"
QUIT
+3 SET LRCOND=$PIECE(LRTEST,"^",2)
SET LRCOND=$SELECT(LRCOND=1:"Ref. Range",LRCOND=2:"Contains",LRCOND=3:"Greater Than",LRCOND=4:"Less Than",LRCOND=5:"Equal To",1:"Unknown")
+4 SET LRDATA=$PIECE($GET(^LAB(60,$PIECE(LRTEST,"^"),0),0),"^")_$EXTRACT(LRFILL,$LENGTH($PIECE($GET(^LAB(60,$PIECE(LRTEST,"^"),0),0),"^")),40)_$JUSTIFY(LRCOND,20)_$JUSTIFY($PIECE(LRTEST,"^",3),10)
+5 SET LREPLNT=$GET(LREPLNT)+1
SET ^TMP($JOB,"LREPDATA",LREPLNT)=LRDATA
End DoDot:2
+6 SET LREPLNT=$GET(LREPLNT)+1
SET ^TMP($JOB,"LREPDATA",LREPLNT)=" Etiology"
ETIO SET LRI=0
FOR
SET LRI=$ORDER(^LAB(69.5,LRA,2,LRI))
if 'LRI
QUIT
Begin DoDot:2
+1 SET LRTEST=$GET(^LAB(69.5,LRA,2,LRI,0))
+2 IF $PIECE(LRTEST,"^")=""
SET LREPLNT=$GET(LREPLNT)+1
SET ^TMP($JOB,"LREPDATA",LREPLNT)="IEN # "_LRA_" damaged. (No Etiology)"
QUIT
+3 SET LRCOND=$PIECE(LRTEST,"^",2)
SET LRCOND=$SELECT(LRCOND=1:"Ref. Range",LRCOND=2:"Contains",LRCOND=3:"Greater Than",LRCOND=4:"Less Than",LRCOND=5:"Equal To",1:"Unknown")
+4 SET LRDATA=$PIECE($GET(^LAB(61.2,$PIECE(LRTEST,"^"),0),0),"^")
+5 SET LREPLNT=$GET(LREPLNT)+1
SET ^TMP($JOB,"LREPDATA",LREPLNT)=LRDATA
End DoDot:2
+6 SET LREPLNT=$GET(LREPLNT)+1
SET ^TMP($JOB,"LREPDATA",LREPLNT)=" ICD"
ICD SET LRI=0
FOR
SET LRI=$ORDER(^LAB(69.5,LRA,3,LRI))
if 'LRI
QUIT
Begin DoDot:2
+1 SET LRICD=$GET(^LAB(69.5,LRA,3,LRI,0))
+2 IF $PIECE(LRICD,"^")=""
SET LREPLNT=$GET(LREPLNT)+1
SET ^TMP($JOB,"LREPDATA",LREPLNT)="IEN # "_LRA_" damaged. (No ICD)"
QUIT
+3 SET LRDATA=$$CODEC^ICDEX(80,$PIECE(LRICD,"^"))
+4 SET LRCSI=$$CSI^ICDEX(80,$PIECE(LRICD,"^"))
+5 SET LRLENGTH=11-$LENGTH(LRDATA)
SET LRSPACES=""
+6 FOR LRPCECNT=1:1:LRLENGTH
SET LRSPACES=LRSPACES_" "
+7 SET LRDATA=LRDATA_LRSPACES_"(ICD-"_$SELECT(LRCSI=30:"10",1:"9")_")"
+8 SET LREPLNT=$GET(LREPLNT)+1
SET ^TMP($JOB,"LREPDATA",LREPLNT)=LRDATA
End DoDot:2
+9 SET LREPLNT=$GET(LREPLNT)+1
SET ^TMP($JOB,"LREPDATA",LREPLNT)=" Microbial Susceptibility Indicator Value"
MICROB SET LRI=0
FOR
SET LRI=$ORDER(^LAB(69.5,LRA,4,LRI))
if 'LRI
QUIT
Begin DoDot:2
+1 SET LRTEST=$GET(^LAB(69.5,LRA,4,LRI,0))
+2 IF $PIECE(LRTEST,"^")=""
SET LREPLNT=$GET(LREPLNT)+1
SET ^TMP($JOB,"LREPDATA",LREPLNT)="IEN # "_LRA_" damaged. (No Microbial Susceptibility)"
QUIT
+3 SET LRCOND=$PIECE(LRTEST,"^",2)
SET LRCOND=$SELECT(LRCOND=1:"Contains",LRCOND=2:"Greater Than",LRCOND=3:"Less Than",LRCOND=4:"Equal To",1:"Unknown")
+4 SET LRDATA=" "_$PIECE($GET(^LAB(62.06,$PIECE(LRTEST,"^"),0),0),"^")_$EXTRACT(LRFILL,$LENGTH($PIECE($GET(^LAB(62.06,$PIECE(LRTEST,"^"),0),0),"^")),33)_$JUSTIFY(LRCOND,20)_$JUSTIFY($PIECE(LRTEST,"^",3),11)
+5 SET LREPLNT=$GET(LREPLNT)+1
SET ^TMP($JOB,"LREPDATA",LREPLNT)=LRDATA
End DoDot:2
End DoDot:1
+6 GOTO EXIT
OUT SET LREPLNT=$GET(LREPLNT)+1
SET ^TMP($JOB,"LREPDATA",LREPLNT)=XMRG_LREPER_LREPST
QUIT
+1 ;Build the text for the return message here.
ZEOR ;LREPISRV
