- ECXUPRO ;ALB/TJL-Prosthetic Pre-Extract Unusual Cost Report ;6/1/17 15:32
- ;;3.0;DSS EXTRACTS;**49,111,144,148,149,154,161,166,187**;Dec 22, 1997;Build 163
- ;
- ; Reference to ^%DT in ICR #10003
- ; Reference to ^%DTC in ICR #10000
- ; Reference to ^XUTMDEVQ in ICR #1519
- ; Reference to ^XLFSTR in ICR #10104
- ; Reference to ^TMP supported by SACC 2.3.2.5.1
- ;
- EN ; entry point
- N X,Y,DATE,ECRUN,ECXDESC,ECXSAVE,ECXTL,ECTHLD,ECXPORT,CNT ;144
- N ECINST,ECSD,ECSD1,ECSTART,ECED,ECEND,ECXERR,QFLG
- N ECXPROUN ;187
- S QFLG=0
- S ECINST=$$PDIV^ECXPUTL
- ; get today's date
- D NOW^%DTC S DATE=X,Y=$E(%,1,12) D DD^%DT S ECRUN=$P(Y,"@") K %DT
- D BEGIN Q:QFLG
- D SELECT Q:QFLG
- S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I ECXPORT D Q ;144
- .K ^TMP($J) ;144
- .;S ^TMP($J,"ECXPORT",0)="NAME^SSN^DATE OF SERVICE^FORM^FORM DESCRIPTION^PSAS HCPCS CODE^FEEDER KEY^QUANTITY^COST OF TRANSACTION^TRANSACTION TYPE^TRAN TYPE DESC" ;144,149,154,161
- .S ^TMP($J,"ECXPORT",0)="NAME^SSN^DATE OF SERVICE^FORM^FORM DESCRIPTION^FEEDER KEY^PSAS HCPCS CODE^PSAS HCPCS CODE DESCRIPTION^TRANSACTION TYPE^TRANSACTION TYPE DESCRIPTION^QUANTITY^" ;187 - Re-arrange columns
- .S ^TMP($J,"ECXPORT",0)=^TMP($J,"ECXPORT",0)_"UNIT OF ISSUE^UNIT OF ISSUE DESCRIPTION^COST OF TRANSACTION" ;187 Re-arrange columns
- .S CNT=1 ;144
- .D PROCESS ;144
- .D EXPDISP^ECXUTL1 ;144
- ;device selection
- S ECXDESC="Prosthetic Pre-Extract Unusual Cost Report" ;tjl 166 Changed report title
- S ECXSAVE("EC*")=""
- W !!,"This report requires 132-column format."
- D EN^XUTMDEVQ("PROCESS^ECXUPRO",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
- W !,"This report prints a listing of unusual costs that would be"
- W !,"generated by the Prosthetic extract (PRO) as determined by a"
- W !,"user-defined threshold value. It should be run prior to the"
- W !,"generation of the actual extract(s) to identify and fix, as"
- W !,"necessary, any costs determined to be erroneous."
- W !!,"Unusual costs are those where the Cost of Transaction is"
- W !,"greater than the threshold value."
- W !!,"Note: The threshold can be set after a report is selected."
- W !!,"Run times for this report will vary depending upon the size of"
- W !,"the extract and could take as long as 30 minutes or more to"
- W !,"complete. This report has no effect on the actual extracts and"
- W !,"can be run as needed."
- W !!,"The report is sorted by Feeder Key, then by descending Cost of"
- W !,"Transaction and SSN."
- W !!,"**NOTE: The feeder key on this report will match what appears in DSS.",!,"However, the feeder key on the report will be different than the feeder",!,"key on the PRO extract." ;149
- S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
- W:$Y!($E(IOST)="C") @IOF,!!
- Q
- ;
- SELECT ; user inputs for threshold cost and date range
- N DONE,OUT
- ; allow user to set threshold cost
- S ECTHLD=500
- W !!,"The default threshold cost for the Prosthetic extract is $"_ECTHLD_".00."
- S DIR(0)="Y",DIR("A")="Would you like to change the threshold?",DIR("B")="NO" D ^DIR K DIR I X["^" S QFLG=1 Q
- I Y D
- .W !!,"Cost > threshold"
- .S DIR(0)="N^0:999999",DIR("A")="Enter the new threshold cost" D ^DIR K DIR S ECTHLD=Y I X["^" S QFLG=1 Q
- ; get date range from user
- W !!,"Enter the date range for which you would like to scan the Prosthetic",!,"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 ECXERR=0 D EN^ECXUPRO1 Q:ECXERR
- S QFLG=0 D PRINT
- Q
- ;
- PRINT ; process temp file and print report
- N PG,QFLG,GTOT,LN,COUNT,FKEY,COST,SSN,REC,SDAY,I,SPACE,UNIT ;144,161,187 - Added UNIT
- U IO
- I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
- S (PG,QFLG,GTOT)=0,$P(LN,"-",132)=""
- I '$G(ECXPORT) D HEADER Q:QFLG ;144
- S COUNT=0,FKEY=""
- F S FKEY=$O(^TMP($J,FKEY)) Q:FKEY=""!QFLG D
- .S COST="" F S COST=$O(^TMP($J,FKEY,COST)) Q:COST=""!QFLG D
- .. S SDAY="" F S SDAY=$O(^TMP($J,FKEY,COST,SDAY)) Q:SDAY=""!QFLG D
- ...S SSN="" F S SSN=$O(^TMP($J,FKEY,COST,SDAY,SSN)) Q:SSN=""!QFLG S REC=^(SSN) D
- ....I $G(ECXPORT) S ^TMP($J,"ECXPORT",CNT)=REC,CNT=CNT+1 Q ;144
- ....S COUNT=COUNT+1
- ....I $Y+3>IOSL D HEADER Q:QFLG
- ....;W !,$P(REC,U),?8,$P(REC,U,2),?21,$P(REC,U,3),?39,$P(REC,U,4),?45,$P(REC,U,5),?70,$P(REC,U,6),?93,$$RJ^XLFSTR($P(REC,U,7),8),?110,$$RJ^XLFSTR($P(REC,U,8),11),?127,$P(REC,U,9) ;149,154
- ....W !,$P(REC,U),?8,$P(REC,U,2),?19,$P(REC,U,3),?30,$P(REC,U,4),?36,$P(REC,U,5),?58,$P(REC,U,6),?66,$E($P(REC,U,7),1,30),?100,$P(REC,U,8) ;187 Re-arrange the columns
- ....W ?103,$P(REC,U,10),?109,$$RJ^XLFSTR($P(REC,U,11),4),?117,$$RJ^XLFSTR($P(REC,U,12),13) ;187 re-arrange the columns
- Q:QFLG!($G(ECXPORT)) ;144
- I COUNT=0 W !!,?8,"No unusual costs to report for this extract"
- I COUNT D ;154,161 Print key to forms and trans type,187 - Added Unit of Issue
- .I $Y+7>IOSL D HEADER Q:QFLG ;Make sure there's enough room for the footer info
- .W ! D FOOTER^ECXPROCT
- .S SPACE=$$REPEAT^XLFSTR(" ",10)
- .W !!,"TRAN TYPE:",!,"I:INITIAL ISSUE",SPACE,"R:REPLACE",SPACE,"S:SPARE",SPACE,"X:REPAIR",SPACE,"5:RENTAL"
- .W !!,"UNIT OF ISSUE:",! ;187
- .S SPACE=$$REPEAT^XLFSTR(" ",5) ;187
- .S UNIT="" ;187
- .F S UNIT=$O(ECXPROUN(UNIT)) Q:UNIT="" D ;187
- ..W UNIT_":",ECXPROUN(UNIT),SPACE
- ..Q:$X>120
- .Q
- 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 !,"Prosthetic Pre-Extract Unusual Cost Report",?124,"Page: "_PG ;tjl 166 Changed report title
- W !,"Start Date: ",ECSTART,?97,"Report Run Date/Time: "_ECRUN
- W !," End Date: ",ECEND,?97," Threshold Value: ",ECTHLD
- ;W !!,?21,"Date of",?45,"PSAS",?112,"Cost of",?126,"Tran" ;149,154
- ;W !,"Name",?11,"SSN",?21,"Service",?39,"FORM",?45,"HCPCS CODE" ;149,154
- ;W ?70,"Feeder Key",?93,"Quantity",?110,"Transaction",?126,"Type" ;149
- W !!,?19,"Date of",?62,"PSAS HCPCS",?98,"Tran",?109,"Unit of",?119,"Cost of" ;187 Re-arrange the columns
- W !,"Name",?11,"SSN",?19,"Service",?30,"FORM",?36,"Feeder Key",?58,"CODE Description",?98,"Type" ;187
- W ?104,"QTY",?109,"Issue",?119,"Transaction" ;187
- W !,LN,!
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXUPRO 6968 printed Feb 18, 2025@23:20:42 Page 2
- ECXUPRO ;ALB/TJL-Prosthetic Pre-Extract Unusual Cost Report ;6/1/17 15:32
- +1 ;;3.0;DSS EXTRACTS;**49,111,144,148,149,154,161,166,187**;Dec 22, 1997;Build 163
- +2 ;
- +3 ; Reference to ^%DT in ICR #10003
- +4 ; Reference to ^%DTC in ICR #10000
- +5 ; Reference to ^XUTMDEVQ in ICR #1519
- +6 ; Reference to ^XLFSTR in ICR #10104
- +7 ; Reference to ^TMP supported by SACC 2.3.2.5.1
- +8 ;
- EN ; entry point
- +1 ;144
- NEW X,Y,DATE,ECRUN,ECXDESC,ECXSAVE,ECXTL,ECTHLD,ECXPORT,CNT
- +2 NEW ECINST,ECSD,ECSD1,ECSTART,ECED,ECEND,ECXERR,QFLG
- +3 ;187
- NEW ECXPROUN
- +4 SET QFLG=0
- +5 SET ECINST=$$PDIV^ECXPUTL
- +6 ; get today's date
- +7 DO NOW^%DTC
- SET DATE=X
- SET Y=$EXTRACT(%,1,12)
- DO DD^%DT
- SET ECRUN=$PIECE(Y,"@")
- KILL %DT
- +8 DO BEGIN
- if QFLG
- QUIT
- +9 DO SELECT
- if QFLG
- QUIT
- +10 ;144
- SET ECXPORT=$$EXPORT^ECXUTL1
- if ECXPORT=-1
- QUIT
- IF ECXPORT
- Begin DoDot:1
- +11 ;144
- KILL ^TMP($JOB)
- +12 ;S ^TMP($J,"ECXPORT",0)="NAME^SSN^DATE OF SERVICE^FORM^FORM DESCRIPTION^PSAS HCPCS CODE^FEEDER KEY^QUANTITY^COST OF TRANSACTION^TRANSACTION TYPE^TRAN TYPE DESC" ;144,149,154,161
- +13 ;187 - Re-arrange columns
- SET ^TMP($JOB,"ECXPORT",0)="NAME^SSN^DATE OF SERVICE^FORM^FORM DESCRIPTION^FEEDER KEY^PSAS HCPCS CODE^PSAS HCPCS CODE DESCRIPTION^TRANSACTION TYPE^TRANSACTION TYPE DESCRIPTION^QUANTITY^"
- +14 ;187 Re-arrange columns
- SET ^TMP($JOB,"ECXPORT",0)=^TMP($JOB,"ECXPORT",0)_"UNIT OF ISSUE^UNIT OF ISSUE DESCRIPTION^COST OF TRANSACTION"
- +15 ;144
- SET CNT=1
- +16 ;144
- DO PROCESS
- +17 ;144
- DO EXPDISP^ECXUTL1
- End DoDot:1
- QUIT
- +18 ;device selection
- +19 ;tjl 166 Changed report title
- SET ECXDESC="Prosthetic Pre-Extract Unusual Cost Report"
- +20 SET ECXSAVE("EC*")=""
- +21 WRITE !!,"This report requires 132-column format."
- +22 DO EN^XUTMDEVQ("PROCESS^ECXUPRO",ECXDESC,.ECXSAVE)
- +23 IF POP
- WRITE !!,"No device selected...exiting.",!
- QUIT
- +24 IF IO'=IO(0)
- DO ^%ZISC
- +25 DO HOME^%ZIS
- +26 DO AUDIT^ECXKILL
- +27 QUIT
- +28 ;
- BEGIN ; display report description
- +1 WRITE @IOF
- +2 WRITE !,"This report prints a listing of unusual costs that would be"
- +3 WRITE !,"generated by the Prosthetic extract (PRO) as determined by a"
- +4 WRITE !,"user-defined threshold value. It should be run prior to the"
- +5 WRITE !,"generation of the actual extract(s) to identify and fix, as"
- +6 WRITE !,"necessary, any costs determined to be erroneous."
- +7 WRITE !!,"Unusual costs are those where the Cost of Transaction is"
- +8 WRITE !,"greater than the threshold value."
- +9 WRITE !!,"Note: The threshold can be set after a report is selected."
- +10 WRITE !!,"Run times for this report will vary depending upon the size of"
- +11 WRITE !,"the extract and could take as long as 30 minutes or more to"
- +12 WRITE !,"complete. This report has no effect on the actual extracts and"
- +13 WRITE !,"can be run as needed."
- +14 WRITE !!,"The report is sorted by Feeder Key, then by descending Cost of"
- +15 WRITE !,"Transaction and SSN."
- +16 ;149
- WRITE !!,"**NOTE: The feeder key on this report will match what appears in DSS.",!,"However, the feeder key on the report will be different than the feeder",!,"key on the PRO extract."
- +17 SET DIR(0)="E"
- WRITE !
- DO ^DIR
- KILL DIR
- IF 'Y
- SET QFLG=1
- QUIT
- +18 if $Y!($EXTRACT(IOST)="C")
- WRITE @IOF,!!
- +19 QUIT
- +20 ;
- SELECT ; user inputs for threshold cost and date range
- +1 NEW DONE,OUT
- +2 ; allow user to set threshold cost
- +3 SET ECTHLD=500
- +4 WRITE !!,"The default threshold cost for the Prosthetic extract is $"_ECTHLD_".00."
- +5 SET DIR(0)="Y"
- SET DIR("A")="Would you like to change the threshold?"
- SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- IF X["^"
- SET QFLG=1
- QUIT
- +6 IF Y
- Begin DoDot:1
- +7 WRITE !!,"Cost > threshold"
- +8 SET DIR(0)="N^0:999999"
- SET DIR("A")="Enter the new threshold cost"
- DO ^DIR
- KILL DIR
- SET ECTHLD=Y
- IF X["^"
- SET QFLG=1
- QUIT
- End DoDot:1
- +9 ; get date range from user
- +10 WRITE !!,"Enter the date range for which you would like to scan the Prosthetic",!,"Extract records.",!
- +11 SET DONE=0
- FOR
- SET (ECED,ECSD)=""
- Begin DoDot:1
- +12 KILL %DT
- SET %DT="AEX"
- SET %DT("A")="Starting with Date: "
- SET %DT(0)=-DATE
- DO ^%DT
- +13 IF Y<0
- SET QFLG=1
- QUIT
- +14 SET ECSD=Y
- SET ECSD1=ECSD-.1
- +15 DO DD^%DT
- SET ECSTART=Y
- +16 KILL %DT
- SET %DT="AEX"
- SET %DT("A")="Ending with Date: "
- SET %DT(0)=-DATE
- DO ^%DT
- +17 IF Y<0
- SET QFLG=1
- QUIT
- +18 IF Y<ECSD
- Begin DoDot:2
- +19 WRITE !!,"The ending date cannot be earlier than the starting date."
- +20 WRITE !,"Please try again.",!!
- End DoDot:2
- QUIT
- +21 IF $EXTRACT(Y,1,5)'=$EXTRACT(ECSD,1,5)
- Begin DoDot:2
- +22 WRITE !!,"Beginning and ending dates must be in the same month and year."
- +23 WRITE !,"Please try again.",!!
- End DoDot:2
- QUIT
- +24 SET ECED=Y
- +25 DO DD^%DT
- SET ECEND=Y
- +26 SET DONE=1
- End DoDot:1
- if QFLG!DONE
- QUIT
- +27 QUIT
- +28 ;
- PROCESS ; entry point for queued report
- +1 SET ZTREQ="@"
- +2 SET ECXERR=0
- DO EN^ECXUPRO1
- if ECXERR
- QUIT
- +3 SET QFLG=0
- DO PRINT
- +4 QUIT
- +5 ;
- PRINT ; process temp file and print report
- +1 ;144,161,187 - Added UNIT
- NEW PG,QFLG,GTOT,LN,COUNT,FKEY,COST,SSN,REC,SDAY,I,SPACE,UNIT
- +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,"-",132)=""
- +5 ;144
- IF '$GET(ECXPORT)
- DO HEADER
- if QFLG
- QUIT
- +6 SET COUNT=0
- SET FKEY=""
- +7 FOR
- SET FKEY=$ORDER(^TMP($JOB,FKEY))
- if FKEY=""!QFLG
- QUIT
- Begin DoDot:1
- +8 SET COST=""
- FOR
- SET COST=$ORDER(^TMP($JOB,FKEY,COST))
- if COST=""!QFLG
- QUIT
- Begin DoDot:2
- +9 SET SDAY=""
- FOR
- SET SDAY=$ORDER(^TMP($JOB,FKEY,COST,SDAY))
- if SDAY=""!QFLG
- QUIT
- Begin DoDot:3
- +10 SET SSN=""
- FOR
- SET SSN=$ORDER(^TMP($JOB,FKEY,COST,SDAY,SSN))
- if SSN=""!QFLG
- QUIT
- SET REC=^(SSN)
- Begin DoDot:4
- +11 ;144
- IF $GET(ECXPORT)
- SET ^TMP($JOB,"ECXPORT",CNT)=REC
- SET CNT=CNT+1
- QUIT
- +12 SET COUNT=COUNT+1
- +13 IF $Y+3>IOSL
- DO HEADER
- if QFLG
- QUIT
- +14 ;W !,$P(REC,U),?8,$P(REC,U,2),?21,$P(REC,U,3),?39,$P(REC,U,4),?45,$P(REC,U,5),?70,$P(REC,U,6),?93,$$RJ^XLFSTR($P(REC,U,7),8),?110,$$RJ^XLFSTR($P(REC,U,8),11),?127,$P(REC,U,9) ;149,154
- +15 ;187 Re-arrange the columns
- WRITE !,$PIECE(REC,U),?8,$PIECE(REC,U,2),?19,$PIECE(REC,U,3),?30,$PIECE(REC,U,4),?36,$PIECE(REC,U,5),?58,$PIECE(REC,U,6),?66,$EXTRACT($PIECE(REC,U,7),1,30),?100,$PIECE(REC,U,8)
- +16 ;187 re-arrange the columns
- WRITE ?103,$PIECE(REC,U,10),?109,$$RJ^XLFSTR($PIECE(REC,U,11),4),?117,$$RJ^XLFSTR($PIECE(REC,U,12),13)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +17 ;144
- if QFLG!($GET(ECXPORT))
- QUIT
- +18 IF COUNT=0
- WRITE !!,?8,"No unusual costs to report for this extract"
- +19 ;154,161 Print key to forms and trans type,187 - Added Unit of Issue
- IF COUNT
- Begin DoDot:1
- +20 ;Make sure there's enough room for the footer info
- IF $Y+7>IOSL
- DO HEADER
- if QFLG
- QUIT
- +21 WRITE !
- DO FOOTER^ECXPROCT
- +22 SET SPACE=$$REPEAT^XLFSTR(" ",10)
- +23 WRITE !!,"TRAN TYPE:",!,"I:INITIAL ISSUE",SPACE,"R:REPLACE",SPACE,"S:SPARE",SPACE,"X:REPAIR",SPACE,"5:RENTAL"
- +24 ;187
- WRITE !!,"UNIT OF ISSUE:",!
- +25 ;187
- SET SPACE=$$REPEAT^XLFSTR(" ",5)
- +26 ;187
- SET UNIT=""
- +27 ;187
- FOR
- SET UNIT=$ORDER(ECXPROUN(UNIT))
- if UNIT=""
- QUIT
- Begin DoDot:2
- +28 WRITE UNIT_":",ECXPROUN(UNIT),SPACE
- +29 if $X>120
- QUIT
- End DoDot:2
- +30 QUIT
- End DoDot:1
- 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 ;tjl 166 Changed report title
- WRITE !,"Prosthetic Pre-Extract Unusual Cost Report",?124,"Page: "_PG
- +8 WRITE !,"Start Date: ",ECSTART,?97,"Report Run Date/Time: "_ECRUN
- +9 WRITE !," End Date: ",ECEND,?97," Threshold Value: ",ECTHLD
- +10 ;W !!,?21,"Date of",?45,"PSAS",?112,"Cost of",?126,"Tran" ;149,154
- +11 ;W !,"Name",?11,"SSN",?21,"Service",?39,"FORM",?45,"HCPCS CODE" ;149,154
- +12 ;W ?70,"Feeder Key",?93,"Quantity",?110,"Transaction",?126,"Type" ;149
- +13 ;187 Re-arrange the columns
- WRITE !!,?19,"Date of",?62,"PSAS HCPCS",?98,"Tran",?109,"Unit of",?119,"Cost of"
- +14 ;187
- WRITE !,"Name",?11,"SSN",?19,"Service",?30,"FORM",?36,"Feeder Key",?58,"CODE Description",?98,"Type"
- +15 ;187
- WRITE ?104,"QTY",?109,"Issue",?119,"Transaction"
- +16 WRITE !,LN,!
- +17 QUIT
- +18 ;