- ECXLARPT ;ALB/DHH-LAR Results LOINC CODE Report ;10/22/13 17:36
- ;;3.0;DSS EXTRACTS;**112,120,144,148**;Dec 22, 1997;Build 3
- ;
- EN ; entry point
- N X,Y,DATE,ECRUN,ECXDESC,ECXSAVE,ECXTL,ECTHLD,CNT,ECXPORT ;144
- N ECSD,ECSD1,ECSTART,ECED,ECEND,ECXERR,QFLG,ECXFLAG
- ; get today's date
- D NOW^%DTC S DATE=X,Y=$E(%,1,12) D DD^%DT S ECRUN=$P(Y,"@") K %DT
- S ECXDESC="LAB Results LOINC CODE Report"
- S ECXSAVE("EC*")=""
- S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I ECXPORT D Q ;144
- .K ^TMP($J,"ECXPORT") ;144
- .S ^TMP($J,"ECXPORT",0)="LAR TEST# (#727.29)^LAR TEST NAME (#727.29)^LAR UNITS (#727.29)^LAR LOINC (#727.29)^FLAG^LOCAL TEST NAME (#64)^LOC SPEC TYPE (#64)^LOC WKLD IEN (#64)^LOC WKLD CODE (#64)" ;144
- .S CNT=1 ;144
- .D PROCESS ;144
- .D EXPDISP^ECXUTL1 ;144
- .D ^ECXKILL ;144
- W !!,"This report requires 132-column format."
- D EN^XUTMDEVQ("PROCESS^ECXLARPT",ECXDESC,.ECXSAVE)
- I POP W !!,"No device selected...exiting.",! Q
- I IO'=IO(0) D ^%ZISC
- D HOME^%ZIS
- D AUDIT^ECXKILL
- Q
- ;
- ;
- PROCESS ; entry point for queued report
- S ZTREQ="@" N ECXDIV
- D DEFAULT^ECXDVSN(.ECXDIV,1,.ECXERR)
- Q:ECXERR=1
- N TNUM,DSSNM,TSTNM,SPECNM,RU,ECXLNC,LLNC,I,J,K,L,M,N,WKLD,WKLDCD,SPEC,TA,LTEST,A
- S A("ALL")=""
- D LOINC^ECXUTL6(.A)
- K ^TMP($J,"ECXLARPT")
- S ECXLNC="" F I=0:0 S ECXLNC=$O(^TMP($J,"ECXUTL6",ECXLNC)) Q:ECXLNC']"" D
- . S RU=$P(^TMP($J,"ECXUTL6",ECXLNC),U,4) S:$G(RU)="" RU="UNKNOWN"
- . S TNUM=$P(^TMP($J,"ECXUTL6",ECXLNC),U,2)
- . S DSSNM=$P(^TMP($J,"ECXUTL6",ECXLNC),U,3)
- . I '$O(^TMP($J,"ECXUTL6",ECXLNC,0)) D
- .. S ^TMP($J,"ECXLARPT",TNUM,DSSNM,"ZZZZ","ZZZZ",RU,ECXLNC)=""
- . S WKLD="" F J=0:0 S WKLD=$O(^TMP($J,"ECXUTL6",ECXLNC,WKLD)) Q:WKLD']"" D
- .. S SPEC="" F K=0:0 S SPEC=$O(^TMP($J,"ECXUTL6",ECXLNC,WKLD,SPEC)) Q:SPEC']"" D
- ... S LTEST="" F M=0:0 S LTEST=$O(^TMP($J,"ECXUTL6",ECXLNC,WKLD,SPEC,LTEST)) Q:LTEST']"" D
- .... S SPECNM=$P(^TMP($J,"ECXUTL6",ECXLNC,WKLD,SPEC,LTEST),U,2)
- .... I SPECNM="DEFAULT LOINC" Q ;ECXUTL6 default loinc not functionally correct
- .... ;I SPECNM="DEFAULT LOINC" S SPECNM="ZZDEFAULT LOINC"
- .... S TSTNM=$P(^TMP($J,"ECXUTL6",ECXLNC,WKLD,SPEC,LTEST),U,3) S:$G(TSTNM)="" TSTNM="UNKNOWN"
- .... S WKLDCD=$S($D(^LAM(WKLD,0)):$P(^(0),"^",2),1:"")
- .... S LLNC=$P(^TMP($J,"ECXUTL6",ECXLNC,WKLD,SPEC,LTEST),U,4)
- .... S ^TMP($J,"ECXLARPT",TNUM,DSSNM,TSTNM,SPECNM,RU,ECXLNC)=WKLD_"^"_WKLDCD_"^"_LLNC
- D PRINT
- Q
- ;
- PRINT ; process temp file and print report
- N PG,QFLG,GTOT,LN,COUNT,VOL,SUB,REC,WKLD1
- U IO
- I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
- S (PG,QFLG,GTOT,COUNT)=0,$P(LN,"-",132)=""
- I '$G(ECXPORT) D HEADER Q:QFLG ;144
- S COUNT=COUNT+1
- S TNUM=0 F I=0:0 S TNUM=$O(^TMP($J,"ECXLARPT",TNUM)) Q:'TNUM D Q:QFLG
- . S DSSNM="" F J=0:0 S DSSNM=$O(^TMP($J,"ECXLARPT",TNUM,DSSNM)) Q:DSSNM']"" D Q:QFLG
- .. S TSTNM="" F K=0:0 S TSTNM=$O(^TMP($J,"ECXLARPT",TNUM,DSSNM,TSTNM)) Q:TSTNM']"" D Q:QFLG
- ... S SPECNM="" F L=0:0 S SPECNM=$O(^TMP($J,"ECXLARPT",TNUM,DSSNM,TSTNM,SPECNM)) Q:SPECNM']"" D Q:QFLG
- .... S RU="" F M=0:0 S RU=$O(^TMP($J,"ECXLARPT",TNUM,DSSNM,TSTNM,SPECNM,RU)) Q:RU']"" D Q:QFLG
- ..... S ECXLNC="" F N=0:0 S ECXLNC=$O(^TMP($J,"ECXLARPT",TNUM,DSSNM,TSTNM,SPECNM,RU,ECXLNC)) Q:ECXLNC']"" D Q:QFLG
- ...... S WKLD1=$P(^TMP($J,"ECXLARPT",TNUM,DSSNM,TSTNM,SPECNM,RU,ECXLNC),"^")
- ...... S WKLDCD=$P(^TMP($J,"ECXLARPT",TNUM,DSSNM,TSTNM,SPECNM,RU,ECXLNC),"^",2)
- ...... S LLNC=$P(^TMP($J,"ECXLARPT",TNUM,DSSNM,TSTNM,SPECNM,RU,ECXLNC),"^",3)
- ...... I $G(ECXPORT) D Q ;144
- ....... S ^TMP($J,"ECXPORT",CNT)=TNUM_U_DSSNM_U_RU_U_ECXLNC_U_$S(WKLD1="":"*",1:"")_U_$S(TSTNM'="ZZZZ":TSTNM,1:"")_U_$S(SPECNM'="ZZZZ":$S(SPECNM="ZZDEFAULT LOINC":"DEFAULT LOINC",1:SPECNM),1:"")_U_WKLD1_U_WKLDCD ;144
- ....... S CNT=CNT+1 ;144
- ...... W !,$$RJ^XLFSTR(TNUM,4,"0"),?11,$E(DSSNM,1,24),?37,$E(RU,1,13),?53,$$RJ^XLFSTR(ECXLNC,10," ") ;,?56,$$RJ^XLFSTR(LLNC,10," ")
- ...... I WKLD1="" W ?67,"*"
- ...... ;I SPECNM'="ZZDEFAULT LOINC",$P(LLNC,"(")'=ECXLNC W ?67,"*"
- ...... W ?71,$S(TSTNM'="ZZZZ":$E(TSTNM,1,24),1:" ")
- ...... W ?97,$S(SPECNM'="ZZZZ":$S(SPECNM="ZZDEFAULT LOINC":"DEFAULT LOINC",1:$E(SPECNM,1,13)),1:" "),?112,$$RJ^XLFSTR(WKLD1,8," "),?122,$$RJ^XLFSTR(WKLDCD,10," ")
- ...... S COUNT=COUNT+1
- ...... I $Y+3>IOSL D HEADER Q:QFLG
- I $G(ECXPORT) Q ;144 stop processing if exporting
- W !!,"FLG ('*'=site not using LOINC code that DSS collects)"
- Q:QFLG
- 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
- K ^TMP($J,"ECXLARPT")
- 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 !,"LAB RESULTS DSS LOINC CODE REPORT",?124,"Page: "_PG
- W !,"Report Run Date/Time: "_ECRUN
- W !,"DSS Site: "_$P(ECXDIV(1),U,2)_" ("_$P(ECXDIV(1),U,3)_")"
- ;W !,?97,"LOC",?117,"LOC",?122,"LOC"
- ;W !!,?68,"F",!,"LAR",?49,"LAR",?61,"LOCAL",?68,"L",?97,"LOC SPEC",?113,"LOC WKLD",?122,"LOC WKLD"
- ;W !,"TEST#",?7,"LAR TEST NAME",?33,"LAR UNITS",?49,"LOINC",?61,"LOINC",?68,"G",?71,"LOCAL TEST NAME",?99,"TYPE",?115,"IEN",?125,"CD"
- W !!,?67,"F",?97,"LOC SPEC",?113,"LOC WKLD",?122,"LOC WKLD"
- W !,"LAR TEST#",?11,"LAR TEST NAME",?37,"LAR UNITS",?53,"LAR LOINC",?67,"L",?71,"LOCAL TEST NAME",?99,"TYPE",?115,"IEN",?124,"CODE"
- W !,"(#727.29)",?13,"(#727.29)",?37,"(#727.29)",?53,"(#727.29)",?67,"G",?76,"(#64)",?99,"(#64)",?115,"(#64)",?124,"(#64)"
- W !,LN,!
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXLARPT 5505 printed Mar 13, 2025@20:57:34 Page 2
- ECXLARPT ;ALB/DHH-LAR Results LOINC CODE Report ;10/22/13 17:36
- +1 ;;3.0;DSS EXTRACTS;**112,120,144,148**;Dec 22, 1997;Build 3
- +2 ;
- EN ; entry point
- +1 ;144
- NEW X,Y,DATE,ECRUN,ECXDESC,ECXSAVE,ECXTL,ECTHLD,CNT,ECXPORT
- +2 NEW ECSD,ECSD1,ECSTART,ECED,ECEND,ECXERR,QFLG,ECXFLAG
- +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 SET ECXDESC="LAB Results LOINC CODE Report"
- +6 SET ECXSAVE("EC*")=""
- +7 ;144
- SET ECXPORT=$$EXPORT^ECXUTL1
- if ECXPORT=-1
- QUIT
- IF ECXPORT
- Begin DoDot:1
- +8 ;144
- KILL ^TMP($JOB,"ECXPORT")
- +9 ;144
- SET ^TMP($JOB,"ECXPORT",0)="LAR TEST# (#727.29)^LAR TEST NAME (#727.29)^LAR UNITS (#727.29)^LAR LOINC (#727.29)^FLAG^LOCAL TEST NAME (#64)^LOC SPEC TYPE (#64)^LOC WKLD IEN (#64)^LOC WKLD CODE (#64)"
- +10 ;144
- SET CNT=1
- +11 ;144
- DO PROCESS
- +12 ;144
- DO EXPDISP^ECXUTL1
- +13 ;144
- DO ^ECXKILL
- End DoDot:1
- QUIT
- +14 WRITE !!,"This report requires 132-column format."
- +15 DO EN^XUTMDEVQ("PROCESS^ECXLARPT",ECXDESC,.ECXSAVE)
- +16 IF POP
- WRITE !!,"No device selected...exiting.",!
- QUIT
- +17 IF IO'=IO(0)
- DO ^%ZISC
- +18 DO HOME^%ZIS
- +19 DO AUDIT^ECXKILL
- +20 QUIT
- +21 ;
- +22 ;
- PROCESS ; entry point for queued report
- +1 SET ZTREQ="@"
- NEW ECXDIV
- +2 DO DEFAULT^ECXDVSN(.ECXDIV,1,.ECXERR)
- +3 if ECXERR=1
- QUIT
- +4 NEW TNUM,DSSNM,TSTNM,SPECNM,RU,ECXLNC,LLNC,I,J,K,L,M,N,WKLD,WKLDCD,SPEC,TA,LTEST,A
- +5 SET A("ALL")=""
- +6 DO LOINC^ECXUTL6(.A)
- +7 KILL ^TMP($JOB,"ECXLARPT")
- +8 SET ECXLNC=""
- FOR I=0:0
- SET ECXLNC=$ORDER(^TMP($JOB,"ECXUTL6",ECXLNC))
- if ECXLNC']""
- QUIT
- Begin DoDot:1
- +9 SET RU=$PIECE(^TMP($JOB,"ECXUTL6",ECXLNC),U,4)
- if $GET(RU)=""
- SET RU="UNKNOWN"
- +10 SET TNUM=$PIECE(^TMP($JOB,"ECXUTL6",ECXLNC),U,2)
- +11 SET DSSNM=$PIECE(^TMP($JOB,"ECXUTL6",ECXLNC),U,3)
- +12 IF '$ORDER(^TMP($JOB,"ECXUTL6",ECXLNC,0))
- Begin DoDot:2
- +13 SET ^TMP($JOB,"ECXLARPT",TNUM,DSSNM,"ZZZZ","ZZZZ",RU,ECXLNC)=""
- End DoDot:2
- +14 SET WKLD=""
- FOR J=0:0
- SET WKLD=$ORDER(^TMP($JOB,"ECXUTL6",ECXLNC,WKLD))
- if WKLD']""
- QUIT
- Begin DoDot:2
- +15 SET SPEC=""
- FOR K=0:0
- SET SPEC=$ORDER(^TMP($JOB,"ECXUTL6",ECXLNC,WKLD,SPEC))
- if SPEC']""
- QUIT
- Begin DoDot:3
- +16 SET LTEST=""
- FOR M=0:0
- SET LTEST=$ORDER(^TMP($JOB,"ECXUTL6",ECXLNC,WKLD,SPEC,LTEST))
- if LTEST']""
- QUIT
- Begin DoDot:4
- +17 SET SPECNM=$PIECE(^TMP($JOB,"ECXUTL6",ECXLNC,WKLD,SPEC,LTEST),U,2)
- +18 ;ECXUTL6 default loinc not functionally correct
- IF SPECNM="DEFAULT LOINC"
- QUIT
- +19 ;I SPECNM="DEFAULT LOINC" S SPECNM="ZZDEFAULT LOINC"
- +20 SET TSTNM=$PIECE(^TMP($JOB,"ECXUTL6",ECXLNC,WKLD,SPEC,LTEST),U,3)
- if $GET(TSTNM)=""
- SET TSTNM="UNKNOWN"
- +21 SET WKLDCD=$SELECT($DATA(^LAM(WKLD,0)):$PIECE(^(0),"^",2),1:"")
- +22 SET LLNC=$PIECE(^TMP($JOB,"ECXUTL6",ECXLNC,WKLD,SPEC,LTEST),U,4)
- +23 SET ^TMP($JOB,"ECXLARPT",TNUM,DSSNM,TSTNM,SPECNM,RU,ECXLNC)=WKLD_"^"_WKLDCD_"^"_LLNC
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +24 DO PRINT
- +25 QUIT
- +26 ;
- PRINT ; process temp file and print report
- +1 NEW PG,QFLG,GTOT,LN,COUNT,VOL,SUB,REC,WKLD1
- +2 USE IO
- +3 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET ZTSTOP=1
- KILL ZTREQ
- QUIT
- +4 SET (PG,QFLG,GTOT,COUNT)=0
- SET $PIECE(LN,"-",132)=""
- +5 ;144
- IF '$GET(ECXPORT)
- DO HEADER
- if QFLG
- QUIT
- +6 SET COUNT=COUNT+1
- +7 SET TNUM=0
- FOR I=0:0
- SET TNUM=$ORDER(^TMP($JOB,"ECXLARPT",TNUM))
- if 'TNUM
- QUIT
- Begin DoDot:1
- +8 SET DSSNM=""
- FOR J=0:0
- SET DSSNM=$ORDER(^TMP($JOB,"ECXLARPT",TNUM,DSSNM))
- if DSSNM']""
- QUIT
- Begin DoDot:2
- +9 SET TSTNM=""
- FOR K=0:0
- SET TSTNM=$ORDER(^TMP($JOB,"ECXLARPT",TNUM,DSSNM,TSTNM))
- if TSTNM']""
- QUIT
- Begin DoDot:3
- +10 SET SPECNM=""
- FOR L=0:0
- SET SPECNM=$ORDER(^TMP($JOB,"ECXLARPT",TNUM,DSSNM,TSTNM,SPECNM))
- if SPECNM']""
- QUIT
- Begin DoDot:4
- +11 SET RU=""
- FOR M=0:0
- SET RU=$ORDER(^TMP($JOB,"ECXLARPT",TNUM,DSSNM,TSTNM,SPECNM,RU))
- if RU']""
- QUIT
- Begin DoDot:5
- +12 SET ECXLNC=""
- FOR N=0:0
- SET ECXLNC=$ORDER(^TMP($JOB,"ECXLARPT",TNUM,DSSNM,TSTNM,SPECNM,RU,ECXLNC))
- if ECXLNC']""
- QUIT
- Begin DoDot:6
- +13 SET WKLD1=$PIECE(^TMP($JOB,"ECXLARPT",TNUM,DSSNM,TSTNM,SPECNM,RU,ECXLNC),"^")
- +14 SET WKLDCD=$PIECE(^TMP($JOB,"ECXLARPT",TNUM,DSSNM,TSTNM,SPECNM,RU,ECXLNC),"^",2)
- +15 SET LLNC=$PIECE(^TMP($JOB,"ECXLARPT",TNUM,DSSNM,TSTNM,SPECNM,RU,ECXLNC),"^",3)
- +16 ;144
- IF $GET(ECXPORT)
- Begin DoDot:7
- +17 ;144
- SET ^TMP($JOB,"ECXPORT",CNT)=TNUM_U_DSSNM_U_RU_U_ECXLNC_U_$SELECT(WKLD1="":"*",1:"")_U_$SELECT(TSTNM'="ZZZZ":TSTNM,1:"")_U_$SELECT(SPECNM'="ZZZZ":$SELECT(SPECNM="ZZDEFAULT LOINC":"DEFAULT
- LOINC",1:SPECNM),1:"")_U_WKLD1_U_WKLDCD
- +18 ;144
- SET CNT=CNT+1
- End DoDot:7
- QUIT
- +19 ;,?56,$$RJ^XLFSTR(LLNC,10," ")
- WRITE !,$$RJ^XLFSTR(TNUM,4,"0"),?11,$EXTRACT(DSSNM,1,24),?37,$EXTRACT(RU,1,13),?53,$$RJ^XLFSTR(ECXLNC,10," ")
- +20 IF WKLD1=""
- WRITE ?67,"*"
- +21 ;I SPECNM'="ZZDEFAULT LOINC",$P(LLNC,"(")'=ECXLNC W ?67,"*"
- +22 WRITE ?71,$SELECT(TSTNM'="ZZZZ":$EXTRACT(TSTNM,1,24),1:" ")
- +23 WRITE ?97,$SELECT(SPECNM'="ZZZZ":$SELECT(SPECNM="ZZDEFAULT LOINC":"DEFAULT LOINC",1:$EXTRACT(SPECNM,1,13)),1:" "),?112,$$RJ^XLFSTR(WKLD1,8," "),?122,$$RJ^XLFSTR(WKLDCD,10," ")
- +24 SET COUNT=COUNT+1
- +25 IF $Y+3>IOSL
- DO HEADER
- if QFLG
- QUIT
- End DoDot:6
- if QFLG
- QUIT
- End DoDot:5
- if QFLG
- QUIT
- End DoDot:4
- if QFLG
- QUIT
- End DoDot:3
- if QFLG
- QUIT
- End DoDot:2
- if QFLG
- QUIT
- End DoDot:1
- if QFLG
- QUIT
- +26 ;144 stop processing if exporting
- IF $GET(ECXPORT)
- QUIT
- +27 WRITE !!,"FLG ('*'=site not using LOINC code that DSS collects)"
- +28 if QFLG
- QUIT
- 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 KILL ^TMP($JOB,"ECXLARPT")
- +5 QUIT
- +6 ;
- +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 !,"LAB RESULTS DSS LOINC CODE REPORT",?124,"Page: "_PG
- +8 WRITE !,"Report Run Date/Time: "_ECRUN
- +9 WRITE !,"DSS Site: "_$PIECE(ECXDIV(1),U,2)_" ("_$PIECE(ECXDIV(1),U,3)_")"
- +10 ;W !,?97,"LOC",?117,"LOC",?122,"LOC"
- +11 ;W !!,?68,"F",!,"LAR",?49,"LAR",?61,"LOCAL",?68,"L",?97,"LOC SPEC",?113,"LOC WKLD",?122,"LOC WKLD"
- +12 ;W !,"TEST#",?7,"LAR TEST NAME",?33,"LAR UNITS",?49,"LOINC",?61,"LOINC",?68,"G",?71,"LOCAL TEST NAME",?99,"TYPE",?115,"IEN",?125,"CD"
- +13 WRITE !!,?67,"F",?97,"LOC SPEC",?113,"LOC WKLD",?122,"LOC WKLD"
- +14 WRITE !,"LAR TEST#",?11,"LAR TEST NAME",?37,"LAR UNITS",?53,"LAR LOINC",?67,"L",?71,"LOCAL TEST NAME",?99,"TYPE",?115,"IEN",?124,"CODE"
- +15 WRITE !,"(#727.29)",?13,"(#727.29)",?37,"(#727.29)",?53,"(#727.29)",?67,"G",?76,"(#64)",?99,"(#64)",?115,"(#64)",?124,"(#64)"
- +16 WRITE !,LN,!
- +17 QUIT
- +18 ;
