- ECXALAR ;ALB/TMD-LAR Extract Report of Untranslatable Results ;7/14/15 16:18
- ;;3.0;DSS EXTRACTS;**46,51,112,132,136,149,154**;Dec 22, 1997;Build 13
- ;
- EN ; entry point
- N X,Y,DATE,ECRUN,ECXOPT,ECXDESC,ECXSAVE,ECXTL,ECTHLD,ECSD,ECSD1,ECSTART,ECED,ECEND,ECXERR,QFLG,PG,ECXPORT,RCNT ;149,154
- S QFLG=0,ECXTL="LAR"
- ; get today's date
- D NOW^%DTC S DATE=X,Y=$E(%,1,12) D DD^%DT S ECRUN=$P(Y,"@") K %DT
- D SETUP^ECXLABR I ECFILE="" Q
- I '$D(ECNODE) S ECNODE=7
- I $P($G(^ECX(728,1,ECNODE+.1)),U,ECPIECE)]"" D Q
- .W !!,$C(7),ECPACK," extract is already scheduled to run. Try later",!!
- D BEGIN Q:QFLG
- S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I $G(ECXPORT) D Q ;149 Section added
- .S RCNT=1
- .D PROCESS
- .S ^TMP($J,"ECXPORT",0)="PATIENT NAME^SSN^DATE/TIME COLLECTED^TEST CODE^TEST NAME^RESULT"
- .D EXPDISP^ECXUTL1
- .D AUDIT^ECXKILL
- S ECXDESC=ECXTL_" Extract Report of Untranslatable Results"
- S ECXSAVE("EC*")=""
- D EN^XUTMDEVQ("PROCESS^ECXALAR",ECXDESC,.ECXSAVE)
- I POP W !!,"No device selected...exiting.",! Q
- I IO'=IO(0) D ^%ZISC
- D HOME^%ZIS
- D AUDIT^ECXKILL
- Q
- ;
- BEGIN ; display report description
- W @IOF,!,"This report prints a listing of results that are not translatable i.e. have",!,"no entry in the Lab Results Translation File (#727.7)."
- W !!,"This report is a pre-extract type audit report and should be run prior to the",!,"generation of the actual extract. Running this report has no effect on the",!,"actual extract."
- W !!,"**WARNING: This report can take a long time to process. You are encouraged",!,"to queue this report for processing during the evening if possible.**" ;136
- W !!,"Enter the date range for which you would like to scan the ",ECXTL," Extract records.",!
- S DONE=0 F S (ECED,ECSD)="" D Q:QFLG!DONE
- .K %DT S %DT="AEX",%DT("A")="Starting with Date: ",%DT(0)=-DATE D ^%DT
- .I Y<0 S QFLG=1 Q
- .S ECSD=Y,ECSD1=ECSD-.1
- .D DD^%DT S ECSTART=Y
- .K %DT S %DT="AEX",%DT("A")="Ending with Date: ",%DT(0)=-DATE D ^%DT
- .I Y<0 S QFLG=1 Q
- .I Y<ECSD D Q
- ..W !!,"The ending date cannot be earlier than the starting date."
- ..W !,"Please try again.",!!
- .I $E(Y,1,5)'=$E(ECSD,1,5) D Q
- ..W !!,"Beginning and ending dates must be in the same month and year."
- ..W !,"Please try again.",!!
- .S ECED=Y
- .D DD^%DT S ECEND=Y
- .S DONE=1
- Q
- ;
- PROCESS ; entry point for queued report
- S ZTREQ="@"
- S $P(^ECX(728,1,ECNODE+.1),U,ECPIECE)="R"
- S ECXERR=0 D EN^ECXALAR2 S $P(^ECX(728,1,ECNODE+.1),U,ECPIECE)="" Q:ECXERR
- S QFLG=0 D PRINT
- Q
- ;
- PRINT ; process temp file and print report
- N X,CNT,LN,REC,ECXDFN,ECXSSN,ECXPNM,ECRS,ECTC,ECFMDT,ECDTM,ECXTNM
- U IO
- I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
- S (PG,QFLG,GTOT)=0,$P(LN,"-",80)=""
- I '$G(ECXPORT) D HEADER Q:QFLG ;149
- S COUNT=0,CNT="" F S CNT=$O(^TMP($J,"ECXALAR2",CNT)) Q:CNT=""!QFLG S REC=^(CNT) D
- .S ECXDFN=$P(REC,U),ECTC=$P(REC,U,4),ECRS=$P(REC,U,5)
- .S ECFMDT=$P(REC,U,2)_"."_$P(REC,U,3),ECDTM=$$FMTE^XLFDT(ECFMDT,2)
- .S (ECXPNM,ECXSSN)=""
- .K ECXPAT S OK=$$PAT^ECXUTL3(ECXDFN,,"1;",.ECXPAT)
- .I OK S ECXPNM=ECXPAT("NAME"),ECXSSN=ECXPAT("SSN")
- .S ECXTNM=$O(^ECX(727.29,"AC",+$G(ECTC),0)),ECXTNM=$P(^ECX(727.29,+$G(ECXTNM),0),U,3)
- .I $G(ECXPORT) S ^TMP($J,"ECXPORT",RCNT)=ECXPNM_U_ECXSSN_U_ECDTM_U_ECTC_U_ECXTNM_U_ECRS,RCNT=RCNT+1 Q ;149
- .I $Y+3>IOSL D HEADER
- .W !,ECXPNM,?5,ECXSSN,?17,ECDTM,?32,$J(ECTC,4),?38,$E(ECXTNM,1,20),?60,$S($L(ECRS)>20:$E(ECRS,1,19)_"+",1:ECRS) ;154 Print result if 20 or less, otherwise print first 19 characters and +
- .S COUNT=COUNT+1
- I $G(ECXPORT) Q ;149
- Q:QFLG
- I COUNT=0 W !!,?8,"No untranslatable results for this extract"
- CLOSE ;
- I $E(IOST)="C",'QFLG D
- .S SS=22-$Y F JJ=1:1:SS W !
- .S DIR(0)="E" W ! D ^DIR K DIR
- Q
- ;
- N SS,JJ
- I $E(IOST)="C" D
- .S SS=22-$Y F JJ=1:1:SS W !
- .I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFLG=1
- Q:QFLG
- W:$Y!($E(IOST)="C") @IOF S PG=PG+1
- W !,ECXTL_" Extract Untranslatable Results Audit Report",?71,"Page: "_PG
- W !,"Start Date: ",ECSTART
- W !,"End Date: ",ECEND,?49,"Report Run Date: "_ECRUN
- W !!,"Pat.",?5,"SSN",?17,"Date/Time",?32,"Test",?38,"Test Name",?60,"Result"
- W !,"Name",?17,"Collected",?32,"Code"
- W !,LN,!
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXALAR 4232 printed Apr 23, 2025@18:06:26 Page 2
- ECXALAR ;ALB/TMD-LAR Extract Report of Untranslatable Results ;7/14/15 16:18
- +1 ;;3.0;DSS EXTRACTS;**46,51,112,132,136,149,154**;Dec 22, 1997;Build 13
- +2 ;
- EN ; entry point
- +1 ;149,154
- NEW X,Y,DATE,ECRUN,ECXOPT,ECXDESC,ECXSAVE,ECXTL,ECTHLD,ECSD,ECSD1,ECSTART,ECED,ECEND,ECXERR,QFLG,PG,ECXPORT,RCNT
- +2 SET QFLG=0
- SET ECXTL="LAR"
- +3 ; get today's date
- +4 DO NOW^%DTC
- SET DATE=X
- SET Y=$EXTRACT(%,1,12)
- DO DD^%DT
- SET ECRUN=$PIECE(Y,"@")
- KILL %DT
- +5 DO SETUP^ECXLABR
- IF ECFILE=""
- QUIT
- +6 IF '$DATA(ECNODE)
- SET ECNODE=7
- +7 IF $PIECE($GET(^ECX(728,1,ECNODE+.1)),U,ECPIECE)]""
- Begin DoDot:1
- +8 WRITE !!,$CHAR(7),ECPACK," extract is already scheduled to run. Try later",!!
- End DoDot:1
- QUIT
- +9 DO BEGIN
- if QFLG
- QUIT
- +10 ;149 Section added
- SET ECXPORT=$$EXPORT^ECXUTL1
- if ECXPORT=-1
- QUIT
- IF $GET(ECXPORT)
- Begin DoDot:1
- +11 SET RCNT=1
- +12 DO PROCESS
- +13 SET ^TMP($JOB,"ECXPORT",0)="PATIENT NAME^SSN^DATE/TIME COLLECTED^TEST CODE^TEST NAME^RESULT"
- +14 DO EXPDISP^ECXUTL1
- +15 DO AUDIT^ECXKILL
- End DoDot:1
- QUIT
- +16 SET ECXDESC=ECXTL_" Extract Report of Untranslatable Results"
- +17 SET ECXSAVE("EC*")=""
- +18 DO EN^XUTMDEVQ("PROCESS^ECXALAR",ECXDESC,.ECXSAVE)
- +19 IF POP
- WRITE !!,"No device selected...exiting.",!
- QUIT
- +20 IF IO'=IO(0)
- DO ^%ZISC
- +21 DO HOME^%ZIS
- +22 DO AUDIT^ECXKILL
- +23 QUIT
- +24 ;
- BEGIN ; display report description
- +1 WRITE @IOF,!,"This report prints a listing of results that are not translatable i.e. have",!,"no entry in the Lab Results Translation File (#727.7)."
- +2 WRITE !!,"This report is a pre-extract type audit report and should be run prior to the",!,"generation of the actual extract. Running this report has no effect on the",!,"actual extract."
- +3 ;136
- WRITE !!,"**WARNING: This report can take a long time to process. You are encouraged",!,"to queue this report for processing during the evening if possible.**"
- +4 WRITE !!,"Enter the date range for which you would like to scan the ",ECXTL," Extract records.",!
- +5 SET DONE=0
- FOR
- SET (ECED,ECSD)=""
- Begin DoDot:1
- +6 KILL %DT
- SET %DT="AEX"
- SET %DT("A")="Starting with Date: "
- SET %DT(0)=-DATE
- DO ^%DT
- +7 IF Y<0
- SET QFLG=1
- QUIT
- +8 SET ECSD=Y
- SET ECSD1=ECSD-.1
- +9 DO DD^%DT
- SET ECSTART=Y
- +10 KILL %DT
- SET %DT="AEX"
- SET %DT("A")="Ending with Date: "
- SET %DT(0)=-DATE
- DO ^%DT
- +11 IF Y<0
- SET QFLG=1
- QUIT
- +12 IF Y<ECSD
- Begin DoDot:2
- +13 WRITE !!,"The ending date cannot be earlier than the starting date."
- +14 WRITE !,"Please try again.",!!
- End DoDot:2
- QUIT
- +15 IF $EXTRACT(Y,1,5)'=$EXTRACT(ECSD,1,5)
- Begin DoDot:2
- +16 WRITE !!,"Beginning and ending dates must be in the same month and year."
- +17 WRITE !,"Please try again.",!!
- End DoDot:2
- QUIT
- +18 SET ECED=Y
- +19 DO DD^%DT
- SET ECEND=Y
- +20 SET DONE=1
- End DoDot:1
- if QFLG!DONE
- QUIT
- +21 QUIT
- +22 ;
- PROCESS ; entry point for queued report
- +1 SET ZTREQ="@"
- +2 SET $PIECE(^ECX(728,1,ECNODE+.1),U,ECPIECE)="R"
- +3 SET ECXERR=0
- DO EN^ECXALAR2
- SET $PIECE(^ECX(728,1,ECNODE+.1),U,ECPIECE)=""
- if ECXERR
- QUIT
- +4 SET QFLG=0
- DO PRINT
- +5 QUIT
- +6 ;
- PRINT ; process temp file and print report
- +1 NEW X,CNT,LN,REC,ECXDFN,ECXSSN,ECXPNM,ECRS,ECTC,ECFMDT,ECDTM,ECXTNM
- +2 USE IO
- +3 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET ZTSTOP=1
- KILL ZTREQ
- QUIT
- +4 SET (PG,QFLG,GTOT)=0
- SET $PIECE(LN,"-",80)=""
- +5 ;149
- IF '$GET(ECXPORT)
- DO HEADER
- if QFLG
- QUIT
- +6 SET COUNT=0
- SET CNT=""
- FOR
- SET CNT=$ORDER(^TMP($JOB,"ECXALAR2",CNT))
- if CNT=""!QFLG
- QUIT
- SET REC=^(CNT)
- Begin DoDot:1
- +7 SET ECXDFN=$PIECE(REC,U)
- SET ECTC=$PIECE(REC,U,4)
- SET ECRS=$PIECE(REC,U,5)
- +8 SET ECFMDT=$PIECE(REC,U,2)_"."_$PIECE(REC,U,3)
- SET ECDTM=$$FMTE^XLFDT(ECFMDT,2)
- +9 SET (ECXPNM,ECXSSN)=""
- +10 KILL ECXPAT
- SET OK=$$PAT^ECXUTL3(ECXDFN,,"1;",.ECXPAT)
- +11 IF OK
- SET ECXPNM=ECXPAT("NAME")
- SET ECXSSN=ECXPAT("SSN")
- +12 SET ECXTNM=$ORDER(^ECX(727.29,"AC",+$GET(ECTC),0))
- SET ECXTNM=$PIECE(^ECX(727.29,+$GET(ECXTNM),0),U,3)
- +13 ;149
- IF $GET(ECXPORT)
- SET ^TMP($JOB,"ECXPORT",RCNT)=ECXPNM_U_ECXSSN_U_ECDTM_U_ECTC_U_ECXTNM_U_ECRS
- SET RCNT=RCNT+1
- QUIT
- +14 IF $Y+3>IOSL
- DO HEADER
- +15 ;154 Print result if 20 or less, otherwise print first 19 characters and +
- WRITE !,ECXPNM,?5,ECXSSN,?17,ECDTM,?32,$JUSTIFY(ECTC,4),?38,$EXTRACT(ECXTNM,1,20),?60,$SELECT($LENGTH(ECRS)>20:$EXTRACT(ECRS,1,19)_"+",1:ECRS)
- +16 SET COUNT=COUNT+1
- End DoDot:1
- +17 ;149
- IF $GET(ECXPORT)
- QUIT
- +18 if QFLG
- QUIT
- +19 IF COUNT=0
- WRITE !!,?8,"No untranslatable results for this extract"
- CLOSE ;
- +1 IF $EXTRACT(IOST)="C"
- IF 'QFLG
- Begin DoDot:1
- +2 SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- +3 SET DIR(0)="E"
- WRITE !
- DO ^DIR
- KILL DIR
- End DoDot:1
- +4 QUIT
- +5 ;
- +1 NEW SS,JJ
- +2 IF $EXTRACT(IOST)="C"
- Begin DoDot:1
- +3 SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- +4 IF PG>0
- SET DIR(0)="E"
- WRITE !
- DO ^DIR
- KILL DIR
- if 'Y
- SET QFLG=1
- End DoDot:1
- +5 if QFLG
- QUIT
- +6 if $Y!($EXTRACT(IOST)="C")
- WRITE @IOF
- SET PG=PG+1
- +7 WRITE !,ECXTL_" Extract Untranslatable Results Audit Report",?71,"Page: "_PG
- +8 WRITE !,"Start Date: ",ECSTART
- +9 WRITE !,"End Date: ",ECEND,?49,"Report Run Date: "_ECRUN
- +10 WRITE !!,"Pat.",?5,"SSN",?17,"Date/Time",?32,"Test",?38,"Test Name",?60,"Result"
- +11 WRITE !,"Name",?17,"Collected",?32,"Code"
- +12 WRITE !,LN,!
- +13 QUIT
- +14 ;
