ECXPROCT ;ALB/GTS - ProstheticS Cost by PSAS HCPC Report DSS ;4/27/16 16:31
;;3.0;DSS EXTRACTS;**71,100,144,154,161**;Dec 22, 1997;Build 6
;
EN ;entry point from option
;Initialize varables
N DIR,ECSD1,ECED,X,Y,ECXPORT,I ;144
;Prompt for start date
S DIR(0)="D^::EX"
S DIR("A")="Enter Report Start Date"
D ^DIR
I $D(DIRUT) Q
S ECSD1=Y
;Prompt for end date
K DIR,X,Y
S DIR(0)="D^"_ECSD1_":"_DT_":EX"
S DIR("A")="Enter Report Ending Date"
D ^DIR
I $D(DIRUT) Q
S ECED=Y
S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I ECXPORT D Q ;144
.K ^TMP($J,"ECXPORT") ;144
.S ^TMP($J,"ECXPORT",0)="PSAS HCPC^FEEDER KEY^DESCRIPTION^FORM^FORM DESCRIPTION^QTY^UNIT OF ISSUE^COST" ;144,154,161
.D EN1 ;144
.M ^TMP($J,"ECXPORT")=^TMP("ECXDSS",$J) ;144 Move results to export display global
.D EXPDISP^ECXUTL1 ;144
;Queue Report
W !!,"** REPORT REQUIRES 132 COLUMNS TO PRINT CORRECTLY **",!!
N ZTDESC,ZTIO,ZTSAVE
S ZTIO=""
S ZTDESC="Prosthetic Cost by PSAS HCPC Report for DSS"
F I="ECSD1","ECED","ECXPHCPC","ECXPHDESC","ECXHCPC","ECXQTY","ECXUOFI","ECXCOST","ECXTCOST" D
.S ZTSAVE(I)=""
D EN^XUTMDEVQ("EN1^ECXPROCT",ZTDESC,.ZTSAVE)
Q
;
EN1 ;Tasked entry point
;Input : ECSD1 - FM format report start date
; ECED - FM format report end date
;
;Output : None
;
;Declare variables
N ECXPHCPC,ECHCDES,ECXHCPC,ECXQTY,ECXUOFI,ECXCOST,ECXTCOST,PAGENUM ;144
N ECXLNE,ECXCT,ECXDACT,ECX0,ECX1,ECXED1,ECINSTSV,ECXLNSTR,ECXP
N DIC,DR,DA,DIQ,CNT,STOP,QFLG,ECXDIV,ECXDFN,ECXFORM ;144
K ^TMP("ECXDSS",$J) ;161
S ECXED1=ECED+.9999,ECXCT=ECSD1-.1,(CNT,QFLG,PAGENUM,ECXTCOST,ECXQTY,STOP)=0 ;154 Changed start date to begin before selected date so records on the date are found
S ECXLNE=1 ;161
I '$G(ECXPORT) D HEADER I STOP D EXIT Q ;144
D GETDATA I $G(ECXPORT) Q ;144 Have data, no need to print.
I '$D(^TMP("ECXDSS",$J)) D Q
.W !
.W !,"***********************************************"
.W !,"* NOTHING TO REPORT FOR SELECTED TIME FRAME *"
.W !,"***********************************************"
.D WAIT
D DETAIL I STOP D EXIT Q
D TOTAL
D FOOTER ;154
K ^TMP("ECXDSS",$J)
Q
;
GETDATA ;Get data
N ECXFELOC,ECXFEKEY,ECXLB,ECINST,ECXLAB,ECX15KEY,RES ;161
F S ECXCT=$O(^RMPR(660,"CT",ECXCT)),CNT=CNT+1 Q:(ECXCT>ECXED1)!('ECXCT)!(QFLG=1) D
.S ECXDACT=0
.F S ECXDACT=$O(^RMPR(660,"CT",ECXCT,ECXDACT)) Q:('ECXDACT)!(QFLG=1) D
..;Get data nodes and increment counter
..S CNT=CNT+1
..S ECX0=$G(^RMPR(660,ECXDACT,0)),ECX1=$G(^(1))
..Q:'$D(^RMPR(660,ECXDACT,0))
..S ECXPHCPC=$P(ECX1,U,4),ECHCDES=$P(ECX1,U,2),ECXHCPC=$P(ECX0,U,22)
..S ECXQTY=$P(ECX0,U,7),ECXUOFI=$P(ECX0,U,8) ;161
..;Resolve external values for PSAS HCPC
..K DIC S DIC="^RMPR(661.1,",DIC(0)="NZ",X=ECXPHCPC D ^DIC
..;S ECXPHCPC=$P($G(Y(0)),U,1)
..S ECXPHCPC=$E($P($G(Y(0)),U,1),1,5)
..;Resolve external values for HCPC
..K DIC S DIC="^ICPT(",DIC(0)="NZ",X=ECXHCPC D ^DIC
..S ECXHCPC=$P($G(Y(0)),U,1)
..;Resolve external value for unit of issue
..K DIC S DIC="^PRCD(420.5,",DIC(0)="NZ",X=ECXUOFI D ^DIC
..S ECXUOFI=$P($G(Y(0)),U,2)
..S ECXDIV=$$GET1^DIQ(660,ECXDACT,8,"I")
..K ECXP D GETS^DIQ(660,ECXDACT_",",".02;11","IE","ECXP") ;154,161
..S ECXDFN=$G(ECXP(660,ECXDACT_",",.02,"I")) ;154
..S ECXFORM=$G(ECXP(660,ECXDACT_",",11,"E"))_U_$G(ECXP(660,ECXDACT_",",11,"I")) ;154
..S (ECXFELOC,ECXFEKEY,ECX15KEY)="" ;161
..S ECXLB=$G(^RMPR(660,ECXDACT,"LB")) ;161
..S ECXCOST=$S(ECXFORM["-3":+$P(ECXLB,U,9),1:+$P(ECX0,U,16)),ECXTCOST=ECXTCOST+ECXCOST ;161 Use lab total cost if lab related else use total cost
..S ECINST=$$GET1^DIQ(4,+$P(ECX0,U,10)_",",99) ;161
..S RES=$$NTEG^ECXPRO1(ECXDFN,.ECXLNE,ECXDACT,ECX0,ECXLB,ECINST,$P(ECXFORM,U)) ;161
..;Section added in 161 to get feeder key
..I ECXFORM["-3" F ECXLAB="ORD","LAB" D
...D FEEDINFO^ECXPRO2(ECXSRCE,$E(ECXHCPCS,1,5),ECXTYPE,ECXSTAT2,ECXRQST,ECXRCST,ECXLAB,ECXNPPDC)
...S:ECXFELOC'="" ECX15KEY=$S(ECX15KEY'="":ECX15KEY_"/"_ECXFEKEY,1:ECXFEKEY)
..I ECXFORM["-3" S ^TMP("ECXDSS",$J,CNT)=ECXPHCPC_U_ECX15KEY_U_ECHCDES_U_$P(ECXFORM,U,2)_$S($G(ECXPORT):(U_$P(ECXFORM,U)),1:"")_U_ECXQTY_U_ECXUOFI_U_ECXCOST ;154,161 Replaced HCPC with FORM data, added feeder
..I ECXFORM'["-3" S ECXLAB="NONL" D
...D FEEDINFO^ECXPRO2(ECXSRCE,$E(ECXHCPCS,1,5),ECXTYPE,ECXSTAT2,ECXRQST,ECXRCST,ECXLAB,ECXNPPDC)
...S ^TMP("ECXDSS",$J,CNT)=ECXPHCPC_U_ECXFEKEY_U_ECHCDES_U_$P(ECXFORM,U,2)_$S($G(ECXPORT):(U_$P(ECXFORM,U)),1:"")_U_ECXQTY_U_ECXUOFI_U_ECXCOST ;154,161 Replaced HCPC with FORM data, added feeder key
..Q
.Q
Q
N LN ;144
S PAGENUM=PAGENUM+1
S $P(LN,"-",132)=""
W @IOF
W !,"Cost by PSAS HCPC REPORT for "_$P($$SITE^VASITE,U,2)_" station "_$P($$SITE^VASITE,U,3),?120,"Page: ",PAGENUM
W !!,"Report for ",$$FMTE^XLFDT(ECSD1)," thru ",$$FMTE^XLFDT(ECED)
W !,?1,"PSAS HCPC",?11,"FEEDER KEY",?30,"DESCRIPTION",?89,"FORM",?98,"QTY",?104,"Unit of Issue",?126,"Cost" ;154 Replaced HCPC with FORM ;161 added feeder key
W !?1,LN
Q
;
DETAIL ;Print detailed line
;Input : ^TMP("ECXDSS",$J) full global reference
; ECXPHCPC - PSAS HCPCS
; ECXPHDESC - PSAS HCPC Description
; ECXHCPC - HCPCS ;154 No longer on report
; ECXQTY - Quantity
; ECXUOFI - Unit of issue
; ECXCOST - Total cost
; ECXFORM - Form requested on
;Output : None
N RECORD,NODE ;144
S RECORD=0 F S RECORD=$O(^TMP("ECXDSS",$J,RECORD)) Q:'RECORD!(STOP) D
.S NODE=^TMP("ECXDSS",$J,RECORD)
.W !?1,$$RJ^XLFSTR($P(NODE,U,1),6),?11,$P($P(NODE,U,2),"/"),?30,$E($P(NODE,U,3),1,57),?89,$P(NODE,U,4),?98,$$LJ^XLFSTR($P(NODE,U,5),5),?107,$P(NODE,U,6) ;154,161
.W ?122,"$"_$$RJ^XLFSTR($P($P(NODE,U,7),".",1),6)_"."_$$LJ^XLFSTR($P($P(NODE,U,7),".",2),2,0) ;161
.I $P(NODE,U,2)["/" W !,?11,$P($P(NODE,U,2),"/",2) ;161 print 2nd feeder key if it exists
.I $Y>(IOSL-5) D WAIT Q:STOP D HEADER
.Q
Q
;
TOTAL ;Report totals
N DASH
S $P(DASH,"=",15)=""
W !!,?118,DASH
W !?90,"Grand Total: ",?118,"$ "_$$RJ^XLFSTR($FNUMBER(ECXTCOST,",",2),11)
Q
;
WAIT ;End of page logic
;Input ; None
;Output ; STOP - Flag inidcating if printing should continue
; 1 = Stop 0 = Continue
;
S STOP=0
;CRT - Prompt for continue
I $E(IOST,1,2)="C-"&(IOSL'>24) D Q
.F Q:$Y>(IOSL-3) W !
.N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
.S DIR(0)="E"
.D ^DIR
.S STOP=$S(Y'=1:1,1:0)
;Background task - check taskman
S STOP=$$S^%ZTLOAD()
I STOP D
.W !,"*********************************************"
.W !,"* PRINTING OF REPORT STOPPED AS REQUESTED *"
.W !,"*********************************************"
Q
EXIT ;Kill temp global
K ^TMP("ECXDSS",$J)
Q
;
W !,"FORM:"
W !,"1:PSC",?10,"2:2421",?18,"3:2237",?34,"4:2529-3",?54,"5:2529-7",?74,"6:2472",?83,"7:2431",?99,"8:2914"
W !,"9:OTHER",?9,"10:2520",?17,"11:STOCK ISSUE",?33,"12:INVENTORY ISSUE",?53,"13:HISTORICAL DATA",?73,"14:VISA",?82,"15:LAB ISSUE-3",?98,"16:DALC"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXPROCT 7143 printed Oct 16, 2024@17:54:19 Page 2
ECXPROCT ;ALB/GTS - ProstheticS Cost by PSAS HCPC Report DSS ;4/27/16 16:31
+1 ;;3.0;DSS EXTRACTS;**71,100,144,154,161**;Dec 22, 1997;Build 6
+2 ;
EN ;entry point from option
+1 ;Initialize varables
+2 ;144
NEW DIR,ECSD1,ECED,X,Y,ECXPORT,I
+3 ;Prompt for start date
+4 SET DIR(0)="D^::EX"
+5 SET DIR("A")="Enter Report Start Date"
+6 DO ^DIR
+7 IF $DATA(DIRUT)
QUIT
+8 SET ECSD1=Y
+9 ;Prompt for end date
+10 KILL DIR,X,Y
+11 SET DIR(0)="D^"_ECSD1_":"_DT_":EX"
+12 SET DIR("A")="Enter Report Ending Date"
+13 DO ^DIR
+14 IF $DATA(DIRUT)
QUIT
+15 SET ECED=Y
+16 ;144
SET ECXPORT=$$EXPORT^ECXUTL1
if ECXPORT=-1
QUIT
IF ECXPORT
Begin DoDot:1
+17 ;144
KILL ^TMP($JOB,"ECXPORT")
+18 ;144,154,161
SET ^TMP($JOB,"ECXPORT",0)="PSAS HCPC^FEEDER KEY^DESCRIPTION^FORM^FORM DESCRIPTION^QTY^UNIT OF ISSUE^COST"
+19 ;144
DO EN1
+20 ;144 Move results to export display global
MERGE ^TMP($JOB,"ECXPORT")=^TMP("ECXDSS",$JOB)
+21 ;144
DO EXPDISP^ECXUTL1
End DoDot:1
QUIT
+22 ;Queue Report
+23 WRITE !!,"** REPORT REQUIRES 132 COLUMNS TO PRINT CORRECTLY **",!!
+24 NEW ZTDESC,ZTIO,ZTSAVE
+25 SET ZTIO=""
+26 SET ZTDESC="Prosthetic Cost by PSAS HCPC Report for DSS"
+27 FOR I="ECSD1","ECED","ECXPHCPC","ECXPHDESC","ECXHCPC","ECXQTY","ECXUOFI","ECXCOST","ECXTCOST"
Begin DoDot:1
+28 SET ZTSAVE(I)=""
End DoDot:1
+29 DO EN^XUTMDEVQ("EN1^ECXPROCT",ZTDESC,.ZTSAVE)
+30 QUIT
+31 ;
EN1 ;Tasked entry point
+1 ;Input : ECSD1 - FM format report start date
+2 ; ECED - FM format report end date
+3 ;
+4 ;Output : None
+5 ;
+6 ;Declare variables
+7 ;144
NEW ECXPHCPC,ECHCDES,ECXHCPC,ECXQTY,ECXUOFI,ECXCOST,ECXTCOST,PAGENUM
+8 NEW ECXLNE,ECXCT,ECXDACT,ECX0,ECX1,ECXED1,ECINSTSV,ECXLNSTR,ECXP
+9 ;144
NEW DIC,DR,DA,DIQ,CNT,STOP,QFLG,ECXDIV,ECXDFN,ECXFORM
+10 ;161
KILL ^TMP("ECXDSS",$JOB)
+11 ;154 Changed start date to begin before selected date so records on the date are found
SET ECXED1=ECED+.9999
SET ECXCT=ECSD1-.1
SET (CNT,QFLG,PAGENUM,ECXTCOST,ECXQTY,STOP)=0
+12 ;161
SET ECXLNE=1
+13 ;144
IF '$GET(ECXPORT)
DO HEADER
IF STOP
DO EXIT
QUIT
+14 ;144 Have data, no need to print.
DO GETDATA
IF $GET(ECXPORT)
QUIT
+15 IF '$DATA(^TMP("ECXDSS",$JOB))
Begin DoDot:1
+16 WRITE !
+17 WRITE !,"***********************************************"
+18 WRITE !,"* NOTHING TO REPORT FOR SELECTED TIME FRAME *"
+19 WRITE !,"***********************************************"
+20 DO WAIT
End DoDot:1
QUIT
+21 DO DETAIL
IF STOP
DO EXIT
QUIT
+22 DO TOTAL
+23 ;154
DO FOOTER
+24 KILL ^TMP("ECXDSS",$JOB)
+25 QUIT
+26 ;
GETDATA ;Get data
+1 ;161
NEW ECXFELOC,ECXFEKEY,ECXLB,ECINST,ECXLAB,ECX15KEY,RES
+2 FOR
SET ECXCT=$ORDER(^RMPR(660,"CT",ECXCT))
SET CNT=CNT+1
if (ECXCT>ECXED1)!('ECXCT)!(QFLG=1)
QUIT
Begin DoDot:1
+3 SET ECXDACT=0
+4 FOR
SET ECXDACT=$ORDER(^RMPR(660,"CT",ECXCT,ECXDACT))
if ('ECXDACT)!(QFLG=1)
QUIT
Begin DoDot:2
+5 ;Get data nodes and increment counter
+6 SET CNT=CNT+1
+7 SET ECX0=$GET(^RMPR(660,ECXDACT,0))
SET ECX1=$GET(^(1))
+8 if '$DATA(^RMPR(660,ECXDACT,0))
QUIT
+9 SET ECXPHCPC=$PIECE(ECX1,U,4)
SET ECHCDES=$PIECE(ECX1,U,2)
SET ECXHCPC=$PIECE(ECX0,U,22)
+10 ;161
SET ECXQTY=$PIECE(ECX0,U,7)
SET ECXUOFI=$PIECE(ECX0,U,8)
+11 ;Resolve external values for PSAS HCPC
+12 KILL DIC
SET DIC="^RMPR(661.1,"
SET DIC(0)="NZ"
SET X=ECXPHCPC
DO ^DIC
+13 ;S ECXPHCPC=$P($G(Y(0)),U,1)
+14 SET ECXPHCPC=$EXTRACT($PIECE($GET(Y(0)),U,1),1,5)
+15 ;Resolve external values for HCPC
+16 KILL DIC
SET DIC="^ICPT("
SET DIC(0)="NZ"
SET X=ECXHCPC
DO ^DIC
+17 SET ECXHCPC=$PIECE($GET(Y(0)),U,1)
+18 ;Resolve external value for unit of issue
+19 KILL DIC
SET DIC="^PRCD(420.5,"
SET DIC(0)="NZ"
SET X=ECXUOFI
DO ^DIC
+20 SET ECXUOFI=$PIECE($GET(Y(0)),U,2)
+21 SET ECXDIV=$$GET1^DIQ(660,ECXDACT,8,"I")
+22 ;154,161
KILL ECXP
DO GETS^DIQ(660,ECXDACT_",",".02;11","IE","ECXP")
+23 ;154
SET ECXDFN=$GET(ECXP(660,ECXDACT_",",.02,"I"))
+24 ;154
SET ECXFORM=$GET(ECXP(660,ECXDACT_",",11,"E"))_U_$GET(ECXP(660,ECXDACT_",",11,"I"))
+25 ;161
SET (ECXFELOC,ECXFEKEY,ECX15KEY)=""
+26 ;161
SET ECXLB=$GET(^RMPR(660,ECXDACT,"LB"))
+27 ;161 Use lab total cost if lab related else use total cost
SET ECXCOST=$SELECT(ECXFORM["-3":+$PIECE(ECXLB,U,9),1:+$PIECE(ECX0,U,16))
SET ECXTCOST=ECXTCOST+ECXCOST
+28 ;161
SET ECINST=$$GET1^DIQ(4,+$PIECE(ECX0,U,10)_",",99)
+29 ;161
SET RES=$$NTEG^ECXPRO1(ECXDFN,.ECXLNE,ECXDACT,ECX0,ECXLB,ECINST,$PIECE(ECXFORM,U))
+30 ;Section added in 161 to get feeder key
+31 IF ECXFORM["-3"
FOR ECXLAB="ORD","LAB"
Begin DoDot:3
+32 DO FEEDINFO^ECXPRO2(ECXSRCE,$EXTRACT(ECXHCPCS,1,5),ECXTYPE,ECXSTAT2,ECXRQST,ECXRCST,ECXLAB,ECXNPPDC)
+33 if ECXFELOC'=""
SET ECX15KEY=$SELECT(ECX15KEY'="":ECX15KEY_"/"_ECXFEKEY,1:ECXFEKEY)
End DoDot:3
+34 ;154,161 Replaced HCPC with FORM data, added feeder
IF ECXFORM["-3"
SET ^TMP("ECXDSS",$JOB,CNT)=ECXPHCPC_U_ECX15KEY_U_ECHCDES_U_$PIECE(ECXFORM,U,2)_$SELECT($GET(ECXPORT):(U_$PIECE(ECXFORM,U)),1:"")_U_ECXQTY_U_ECXUOFI_U_ECXCOST
+35 IF ECXFORM'["-3"
SET ECXLAB="NONL"
Begin DoDot:3
+36 DO FEEDINFO^ECXPRO2(ECXSRCE,$EXTRACT(ECXHCPCS,1,5),ECXTYPE,ECXSTAT2,ECXRQST,ECXRCST,ECXLAB,ECXNPPDC)
+37 ;154,161 Replaced HCPC with FORM data, added feeder key
SET ^TMP("ECXDSS",$JOB,CNT)=ECXPHCPC_U_ECXFEKEY_U_ECHCDES_U_$PIECE(ECXFORM,U,2)_$SELECT($GET(ECXPORT):(U_$PIECE(ECXFORM,U)),1:"")_U_ECXQTY_U_ECXUOFI_U_ECXCOST
End DoDot:3
+38 QUIT
End DoDot:2
+39 QUIT
End DoDot:1
+40 QUIT
+1 ;144
NEW LN
+2 SET PAGENUM=PAGENUM+1
+3 SET $PIECE(LN,"-",132)=""
+4 WRITE @IOF
+5 WRITE !,"Cost by PSAS HCPC REPORT for "_$PIECE($$SITE^VASITE,U,2)_" station "_$PIECE($$SITE^VASITE,U,3),?120,"Page: ",PAGENUM
+6 WRITE !!,"Report for ",$$FMTE^XLFDT(ECSD1)," thru ",$$FMTE^XLFDT(ECED)
+7 ;154 Replaced HCPC with FORM ;161 added feeder key
WRITE !,?1,"PSAS HCPC",?11,"FEEDER KEY",?30,"DESCRIPTION",?89,"FORM",?98,"QTY",?104,"Unit of Issue",?126,"Cost"
+8 WRITE !?1,LN
+9 QUIT
+10 ;
DETAIL ;Print detailed line
+1 ;Input : ^TMP("ECXDSS",$J) full global reference
+2 ; ECXPHCPC - PSAS HCPCS
+3 ; ECXPHDESC - PSAS HCPC Description
+4 ; ECXHCPC - HCPCS ;154 No longer on report
+5 ; ECXQTY - Quantity
+6 ; ECXUOFI - Unit of issue
+7 ; ECXCOST - Total cost
+8 ; ECXFORM - Form requested on
+9 ;Output : None
+10 ;144
NEW RECORD,NODE
+11 SET RECORD=0
FOR
SET RECORD=$ORDER(^TMP("ECXDSS",$JOB,RECORD))
if 'RECORD!(STOP)
QUIT
Begin DoDot:1
+12 SET NODE=^TMP("ECXDSS",$JOB,RECORD)
+13 ;154,161
WRITE !?1,$$RJ^XLFSTR($PIECE(NODE,U,1),6),?11,$PIECE($PIECE(NODE,U,2),"/"),?30,$EXTRACT($PIECE(NODE,U,3),1,57),?89,$PIECE(NODE,U,4),?98,$$LJ^XLFSTR($PIECE(NODE,U,5),5),?107,$PIECE(NODE,U,6)
+14 ;161
WRITE ?122,"$"_$$RJ^XLFSTR($PIECE($PIECE(NODE,U,7),".",1),6)_"."_$$LJ^XLFSTR($PIECE($PIECE(NODE,U,7),".",2),2,0)
+15 ;161 print 2nd feeder key if it exists
IF $PIECE(NODE,U,2)["/"
WRITE !,?11,$PIECE($PIECE(NODE,U,2),"/",2)
+16 IF $Y>(IOSL-5)
DO WAIT
if STOP
QUIT
DO HEADER
+17 QUIT
End DoDot:1
+18 QUIT
+19 ;
TOTAL ;Report totals
+1 NEW DASH
+2 SET $PIECE(DASH,"=",15)=""
+3 WRITE !!,?118,DASH
+4 WRITE !?90,"Grand Total: ",?118,"$ "_$$RJ^XLFSTR($FNUMBER(ECXTCOST,",",2),11)
+5 QUIT
+6 ;
WAIT ;End of page logic
+1 ;Input ; None
+2 ;Output ; STOP - Flag inidcating if printing should continue
+3 ; 1 = Stop 0 = Continue
+4 ;
+5 SET STOP=0
+6 ;CRT - Prompt for continue
+7 IF $EXTRACT(IOST,1,2)="C-"&(IOSL'>24)
Begin DoDot:1
+8 FOR
if $Y>(IOSL-3)
QUIT
WRITE !
+9 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+10 SET DIR(0)="E"
+11 DO ^DIR
+12 SET STOP=$SELECT(Y'=1:1,1:0)
End DoDot:1
QUIT
+13 ;Background task - check taskman
+14 SET STOP=$$S^%ZTLOAD()
+15 IF STOP
Begin DoDot:1
+16 WRITE !,"*********************************************"
+17 WRITE !,"* PRINTING OF REPORT STOPPED AS REQUESTED *"
+18 WRITE !,"*********************************************"
End DoDot:1
+19 QUIT
EXIT ;Kill temp global
+1 KILL ^TMP("ECXDSS",$JOB)
+2 QUIT
+3 ;
+1 WRITE !,"FORM:"
+2 WRITE !,"1:PSC",?10,"2:2421",?18,"3:2237",?34,"4:2529-3",?54,"5:2529-7",?74,"6:2472",?83,"7:2431",?99,"8:2914"
+3 WRITE !,"9:OTHER",?9,"10:2520",?17,"11:STOCK ISSUE",?33,"12:INVENTORY ISSUE",?53,"13:HISTORICAL DATA",?73,"14:VISA",?82,"15:LAB ISSUE-3",?98,"16:DALC"
+4 QUIT
