- LREPISV1 ;DALOI/CKA LAB EPI EXTRACT SERVER ; 4/1/2003
- ;;5.2;LAB SERVICE;**281**;Sep 27, 1994
- ;
- ; Reference to $$SITE^VASITE supported by IA #10112
- ; Reference to ^%ZOSF supported by IA #10096
- START ;
- K ^TMP($J,"LREPDATA")
- ;Send message to the mail group each time the server is triggered
- ;containing the name of the person who triggered the server, their
- ;location, and the action initiated.
- S LREPST=$P($$SITE^VASITE,"^",2),LRRTYPE=1
- ;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)=$S(LREPSUB["RETRANSMIT":" RETRANSMISSION of EPI data",1:"????")_" 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'["RETRANSMIT" S ^TMP($J,"LREPDATA",3)="SUBJECT OF MAIL MESSAGE MUST BE RETRANSMIT" G EXIT
- RETRANS ;RETRANSMIT
- ;first read the text of the message
- S LRERROR=0
- READ F XMA=1:1 X XMREC Q:XMER<0 S XMTEXT=XMRG D
- .;
- PROCESS .;
- .I XMA=1,XMTEXT'="******password******" S ^TMP($J,"LREPDATA",3)="INVALID PASSWORD" S LRERROR=1 Q
- .;
- .S LRPROT=1696
- DATE .;
- .I XMA=3 D
- ..S X=XMTEXT,%DT="X" D ^%DT
- ..I Y=-1 S ^TMP($J,"LREPDATA",3)="INVALID STOP DATE" S LRERROR=1 Q
- ..S LRRPE=Y ;Stop date
- .I XMA=2 D
- ..S X=XMTEXT,%DT="X" D ^%DT
- ..I Y=-1 S ^TMP($J,"LREPDATA",3)="INVALID START DATE" S LRERROR=1 Q
- ..S LRRPS=Y ;Start date
- .;
- TEST .;pathogens
- .F LRI=4:1 Q:LRI'=XMA D:XMTEXT="ALL" Q:XMTEXT="ALL" S LREPI(LRI)=XMTEXT Q:'$D(XMTEXT) S LREPI(XMTEXT)=""
- ..S LRI=0 F S LRI=$O(^LAB(69.5,LRI)) Q:'LRI!(LRI>99) S LREPI(LRI)=""
- .;
- .;
- I LRERROR G MAIL
- TASK ;
- D NOW^%DTC
- S ZTDTH=%
- Q:'$D(LREPI)
- K ZTSAVE
- S ZTSAVE("LR*")=""
- S ZTIO="",ZTRTN="EN^LREPI",ZTDESC="Laboratory Search/Extract"
- D ^%ZTLOAD
- I $D(ZTSK)[0 W !!?5,"Report canceled!"
- ;
- ;
- MAIL ;
- ;
- ;If the subject contains "RETRANSMIT" DATA EXTRACTION
- 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 XMA,LRA,LRCOND,LRDATA,LRFILL,LRI,LRPATH,LRTEST,LRERROR
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREPISV1 2831 printed Mar 13, 2025@21:18:57 Page 2
- LREPISV1 ;DALOI/CKA LAB EPI EXTRACT SERVER ; 4/1/2003
- +1 ;;5.2;LAB SERVICE;**281**;Sep 27, 1994
- +2 ;
- +3 ; Reference to $$SITE^VASITE supported by IA #10112
- +4 ; Reference to ^%ZOSF supported by IA #10096
- START ;
- +1 KILL ^TMP($JOB,"LREPDATA")
- +2 ;Send message to the mail group each time the server is triggered
- +3 ;containing the name of the person who triggered the server, their
- +4 ;location, and the action initiated.
- +5 SET LREPST=$PIECE($$SITE^VASITE,"^",2)
- SET LRRTYPE=1
- +6 ;Determine station number
- +7 SET X=XQSUB
- XECUTE ^%ZOSF("UPPERCASE")
- SET LREPSUB=Y
- +8 SET ^TMP($JOB,"LREPDATA",1)=LREPSUB_" triggered at "_LREPST_" by "_XMFROM_" on "_XQDATE
- +9 ;The first line of the message tells who requested the action and when
- +10 SET ^TMP($JOB,"LREPDATA",2)=$SELECT(LREPSUB["RETRANSMIT":" RETRANSMISSION of EPI data",1:"????")_" at "_LREPST
- +11 ;The second line tells when the server is activated and no data can be gathered from the MailMan message.
- +12 SET LREPLNT=1
- +13 IF LREPSUB'["RETRANSMIT"
- SET ^TMP($JOB,"LREPDATA",3)="SUBJECT OF MAIL MESSAGE MUST BE RETRANSMIT"
- GOTO EXIT
- RETRANS ;RETRANSMIT
- +1 ;first read the text of the message
- +2 SET LRERROR=0
- READ FOR XMA=1:1
- XECUTE XMREC
- if XMER<0
- QUIT
- SET XMTEXT=XMRG
- Begin DoDot:1
- +1 ;
- PROCESS ;
- +1 IF XMA=1
- IF XMTEXT'="******password******"
- SET ^TMP($JOB,"LREPDATA",3)="INVALID PASSWORD"
- SET LRERROR=1
- QUIT
- +2 ;
- +3 SET LRPROT=1696
- DATE ;
- +1 IF XMA=3
- Begin DoDot:2
- +2 SET X=XMTEXT
- SET %DT="X"
- DO ^%DT
- +3 IF Y=-1
- SET ^TMP($JOB,"LREPDATA",3)="INVALID STOP DATE"
- SET LRERROR=1
- QUIT
- +4 ;Stop date
- SET LRRPE=Y
- End DoDot:2
- +5 IF XMA=2
- Begin DoDot:2
- +6 SET X=XMTEXT
- SET %DT="X"
- DO ^%DT
- +7 IF Y=-1
- SET ^TMP($JOB,"LREPDATA",3)="INVALID START DATE"
- SET LRERROR=1
- QUIT
- +8 ;Start date
- SET LRRPS=Y
- End DoDot:2
- +9 ;
- TEST ;pathogens
- +1 FOR LRI=4:1
- if LRI'=XMA
- QUIT
- if XMTEXT="ALL"
- Begin DoDot:2
- +2 SET LRI=0
- FOR
- SET LRI=$ORDER(^LAB(69.5,LRI))
- if 'LRI!(LRI>99)
- QUIT
- SET LREPI(LRI)=""
- End DoDot:2
- if XMTEXT="ALL"
- QUIT
- SET LREPI(LRI)=XMTEXT
- if '$DATA(XMTEXT)
- QUIT
- SET LREPI(XMTEXT)=""
- +3 ;
- +4 ;
- End DoDot:1
- +5 IF LRERROR
- GOTO MAIL
- TASK ;
- +1 DO NOW^%DTC
- +2 SET ZTDTH=%
- +3 if '$DATA(LREPI)
- QUIT
- +4 KILL ZTSAVE
- +5 SET ZTSAVE("LR*")=""
- +6 SET ZTIO=""
- SET ZTRTN="EN^LREPI"
- SET ZTDESC="Laboratory Search/Extract"
- +7 DO ^%ZTLOAD
- +8 IF $DATA(ZTSK)[0
- WRITE !!?5,"Report canceled!"
- +9 ;
- +10 ;
- MAIL ;
- +1 ;
- +2 ;If the subject contains "RETRANSMIT" DATA EXTRACTION
- 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 XMA,LRA,LRCOND,LRDATA,LRFILL,LRI,LRPATH,LRTEST,LRERROR
- +10 QUIT
- +11 ;
