APSAWP11 ;IHS/ITSC/ENM/POC - ACQUISITION COST FILE READ ;12-Feb-2008 15:59;SM
;;7.0;IHS PHARMACY MODIFICATIONS;**1006**; Sep 23, 2004
;THIS RTN READS IN A LOCAL ACTUAL ACQUISTION COST FILE TO THE GLOBAL ^APSAMDF IHS/OKCAO/POC 11/11/2002
; Modified - IHS/MSC/PLS - 09/06/07 - Add changes from Pawhuska for McKesson support
;
EN1(APSPPATH,APSPFILE) ;
S ZTQUEUED=1 ;IF COMING FROM EN1 SET VARIABLE TO CALL SILENTLY
EN ;ENTRY POINT TO IMPORT ACTUAL ACQUISTION COST FILE
;CALLED BY OPTION APSQ IMPORT AAC
L +^TMP("APSAWP11",$J):3 I '$T W:'$D(ZTQUEUED) !,"CAN'T LOCK-IS SOMEONE ELSE RUNNING THIS OPTION?" Q
I '$D(^APSAMDF) L -^TMP("APSAWP11",$J) Q
K ^TMP("APSAWP11",$J)
D CLEAN
W:'$D(ZTQUEUED) !,"THIS OPTION WILL IMPORT ACTUAL ACQUISTION COST INTO THE AWP MED TRANSACTION FILE"
I '$D(ZTQUEUED) W:$D(^APSAMDF("DATEACC")) !,"LAST IMPORT ON DATE ",$$FMTE^XLFDT(^("DATEACC"),1)
I '$D(ZTQUEUED) S Y=$$DIR("Y","DO YOU WISH TO CONTINUE","YES") ;DIR(0),DIR("A"),DIR("B")
I '$D(ZTQUEUED) I Y'=1 D CLEAN Q
S APSAOS=$P($G(^AUTTSITE(1,0)),"^",21)
S APSAPATH=$S($P($G(^AUTTSITE(1,1)),"^",1)]"":$P(^(1),"^",1),APSAOS=1:"/pub",APSAOS=2:"C:\INETPUB\FTPROOT\PUB",$D(APSPPATH):APSPPATH,1:"")
I '$D(ZTQUEUED) S Y=$$DIR("F^3:60","ENTER THE PATH TO THE ACTUAL ACQUISTION FILE",APSAPATH)
I '$D(ZTQUEUED) I Y="^" D CLEAN Q
I '$D(ZTQUEUED) S APSAPATH=Y
I APSAOS=1,$E(APSAPATH,$L(APSAPATH))'="/" S APSAPATH=APSAPATH_"/"
I APSAOS=2,$E(APSAPATH,$L(APSAPATH))'="\" S APSAPATH=APSAPATH_"\"
;
S APSAFILE=$S($D(APSPFILE):APSPFILE,1:"")
I '$D(ZTQUEUED) S Y=$$DIR("F^3:30","ENTER THE NAME OF THE ACTUAL ACQUISTION FILE",APSAFILE)
I '$D(ZTQUEUED) I Y="^" D CLEAN Q
I '$D(ZTQUEUED) S APSAFILE=Y
S Y=$$LIST^%ZISH(APSAPATH,APSAFILE,.APSAGOT)
S Y=$$CHECK
I Y'=1 D CLEAN Q
S Y=$$OPEN^%ZISH(APSAPATH,APSAFILE,"R")
I Y'=0 W:'$D(ZTQUEUED) !,"HMM... CAN'T OPEN THIS FILE... HELP" D CLEAN Q
D FLETCH
D CLOSE(IO)
S ^APSAMDF("DATEACC")=DT
D:'$D(ZTQUEUED) REP
D CLEAN
L -^TMP("APSAWP11",$J) ;UNLOCK
Q
DIR(O,A,B) ;
S DIR(0)=O,DIR("A")=A,DIR("B")=B
D ^DIR
I $D(DTIOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) Q "^"
Q Y
;
CLEAN ;
D EN^XBVK("APSA")
K PAGE,END,LINE,DRUGIEN,TMPIEN,APSAIEN
K DIR,DIC,DIE
Q
;
CHECK() ;CHECK FOR ONLY ONE FILE (THAT'S NOT NONE OR MORE THAN ONE)
N I,CNT
S CNT=0,I=""
F S I=$O(APSAGOT(I)) Q:I="" S CNT=CNT+1
I CNT=0 W:'$D(ZTQUEUED) !,"NO FILE IN PATH "_APSAPATH_" WITH NAME "_APSAFILE_" EXISTS"
I CNT>1 W:'$D(ZTQUEUED) !,"MORE THAN ONE FILE EXISTS FOR THIS PATH "_APSAPATH_" AND THIS FILE NAME "_APSAFILE
I CNT=1 W:'$D(ZTQUEUED) !,"GOT THE FILE "_APSAFILE
Q CNT
;
TRANS(VAL) ;
S VAL=$TR(VAL," ","") ;NO SPACES
;IHS/ITSC/ENM/POC NEXT 5 LINES ADDED 05/14/03
S VAL=$TR(VAL,"""","") ;NO QUOTES
S VAL=$TR(VAL,"-","")
N PIECE,I,NCONT ;STRIP OUT CONTROL CHARACTERS
S NCONT="" F I=1:1:$L(VAL) D
.S PIECE=$E(VAL,I) I PIECE'?1C S NCONT=NCONT_PIECE
Q NCONT
;
ERR(VALUE,APSANUM,APSANDC) ;
S ^TMP("APSAWP11",$J,"SORT"," "_APSANDC)=APSANDC_" "_APSANUM_" "_VALUE
Q
;
SORT N APSANDC S APSANDC=""
K ^TMP("APSAWP11",$J,"ERR") ;IN CASE COME HERE FROM OPTION
F S APSANDC=$O(^TMP("APSAWP11",$J,"SORT",APSANDC)) Q:APSANDC="" D
.S ^(0)=$G(^TMP("APSAWP11",$J,"ERR",0))+1,IEN=^(0)
.S ^TMP("APSAWP11",$J,"ERR",IEN,0)=^TMP("APSAWP11",$J,"SORT",APSANDC)
Q
;
CLOSE(IO) ;
D CLOSE^%ZISH(IO)
Q
FLETCH ;
S APSACNT=0
S APSASTAT=$S($G(^%ZOSF("OS"))["OpenM":-1,$G(^%ZOSF("OS"))["Windows":1,$G(^%ZOSF("OS"))["UNIX":-1,1:-1)
F U IO R APSANODE:5 Q:($$STATUS^%ZISH=APSASTAT)!'$T D ;DO I HAVE TO HAVE A TIMEOUT ON A READ??
.U IO(0) ;IHS/OKCAO/POC 5/7/2003
.Q:APSANODE=""
.S APSAQUIT=0
.S APSANODE=$$TRANS(APSANODE) ;ONE TIME INSTEAD OF MANY
.S APSANDC=$P(APSANODE,",",2) ;NDC NUMBER
.S APSAAAC=$P(APSANODE,",",4)
.S APSANUM=$P(APSANODE,",",1)
.I APSAAAC']"" D ERR("NO ACTUAL ACQUISTION COST",APSANUM,APSANDC) S APSAQUIT=1
.I APSANDC']"" D ERR("NO NDC NUMBER",APSANUM,0) S APSAQUIT=1
.I $L(APSANDC)'=11 D ERR("NDC NOT 11 DIGITS",APSANUM,APSANDC) S APSAQUIT=1
.Q:APSAQUIT
.S APSAFNUM=$O(^APSAMDF("B",APSANDC,""))
.I APSAFNUM']"" D ERR("NO ENTRY IN AWP MED TRANSACTION FILE FOR NDC ",APSANUM,APSANDC) S APSAQUIT=1
.Q:APSAQUIT
.S DA=APSAFNUM
.S DIE="^APSAMDF("
.S DR="404///"_APSAAAC
.D ^DIE
.S APSACNT=APSACNT+1
.I '$D(ZTQUEUED) U 0 W "."
I '$D(ZTQUEUED) U 0 W !!,"COUNT OF UPDATES IS ",APSACNT
Q
;
REP ;ENTRY POINT TO PRINT OUT THE ERROR ACTUAL ACQUISTION FILE ENTRIES
;CALLED BY OPTION APSQ PRINT ERRORS FROM IMPORT OF AAC
S LINE="W !?5,""NDC#"",?18,""AAC#"",?27,""ERR"""
U 0 W !!,"ENTER THE DEVICE TO PRINT THE ERROR LIST"
S %ZIS="QM" D ^%ZIS I POP Q
I $D(IO("Q")) D Q
.S ZTRTN="REPORT^APSAWP11",ZTDESC="PRINT ERROR REPORT OF ACUTAL ACQUISTION COST IMPORT"
.S ZTSAVE("LINE")="" ;IHS/ITSC/ENM/POC 5/20/2003
.D ^%ZTLOAD,HOME^%ZIS K IO("Q")
;
REPORT ;
D SORT ;SORT IT OUT FIRST
I $D(ZTQUEUED) S ZTREQ="@"
S:'$D(DTIME) DTIME=20
S (END,PAGE)=0
U IO
D @("HDR"_(2-($E(IOST,1,2)="C-")))
I '$D(^TMP("APSAWP11",$J,"ERR")) W !,"NO ERRORS IN THE ERROR LOG" Q
S APSAIEN=0 F S APSAIEN=$O(^TMP("APSAWP11",$J,"ERR",APSAIEN)) Q:APSAIEN=""!END D
.W !?5,^TMP("APSAWP11",$J,"ERR",APSAIEN,0)
.D HDR:$Y+5>IOSL
D ^%ZISC
D CLEAN
Q
;
REP1 ;ENTRY POINT FOR NO ACTUAL ACQUISTION COST IN THE DRUG FILE
K ^TMP("APSAWP11",$J,"ERR1")
D CLEAN
S LINE="W !?5,""DRUG#"",?30,""DRUG NAME"""
S DRUGIEN=0
F S DRUGIEN=$O(^PSDRUG(DRUGIEN)) Q:DRUGIEN'=+DRUGIEN D
.I $S('$D(^PSDRUG(+DRUGIEN,"I")):0,DT'>^("I"):0,1:1) Q ;INACTIVE
.Q:$P($G(^PSDRUG(+DRUGIEN,660)),"^",6)]"" ;GOT A PRICE
.S ^(0)=$G(^TMP("APSAWP11",$J,"ERR1",0))+1,TMPIEN=^(0)
.S ^TMP("APSAWP11",$J,"ERR1",TMPIEN,0)=$E(+DRUGIEN_" ",1,25)_$P(^PSDRUG(+DRUGIEN,0),"^",1)
.Q
U 0 W !!,"ENTER THE DEVICE TO PRINT THE LIST OF DRUGS WITH NO AAC"
S %ZIS="QM" D ^%ZIS I POP Q
I $D(IO("Q")) D Q
.S ZTRTN="REP1PRT^APSAWP11",ZTDESC="PRINT ERROR REPORT OF ACUTAL ACQUISTION COST IMPORT"
.S ZTSAVE("LINE")="" ;IHS/ITSC/ENM/POC 5/20/2003
.D ^%ZTLOAD,HOME^%ZIS K IO("Q")
;
REP1PRT ;
I $D(ZTQUEUED) S ZTREQ="@"
S:'$D(DTIME) DTIME=20
S (END,PAGE)=0
U IO
D @("HDR"_(2-($E(IOST,1,2)="C-")))
I '$D(^TMP("APSAWP11",$J,"ERR1")) W !,"NO ERRORS IN THE ERROR LOG" Q
S APSAIEN=0 F S APSAIEN=$O(^TMP("APSAWP11",$J,"ERR1",APSAIEN)) Q:APSAIEN=""!END D
.W !?5,^TMP("APSAWP11",$J,"ERR1",APSAIEN,0)
.D HDR:$Y+5>IOSL
K ^TMP("APSAWP11",$J,"ERR1")
D ^%ZISC
D CLEAN
Q
;
HDR I $E(IOST,1,2)="C-" W !,"PRESS RETURN TO CONTINUE OR '^' TO QUIT" R X:DTIME S END='$T!(X="^") Q:END
HDR1 W @IOF
HDR2 S APSALOC=$P(^DIC(4,DUZ(2),0),"^"),APSALEN=$L(APSALOC)
S PAGE=PAGE+1 W ?(IOM-APSALEN/2),APSALOC,?(IOM-12),"PAGE: ",$J(PAGE,3)
X LINE
Q
APSAWP11 ;IHS/ITSC/ENM/POC - ACQUISITION COST FILE READ ;12-Feb-2008 15:59;SM
+1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1006**; Sep 23, 2004
+2 ;THIS RTN READS IN A LOCAL ACTUAL ACQUISTION COST FILE TO THE GLOBAL ^APSAMDF IHS/OKCAO/POC 11/11/2002
+3 ; Modified - IHS/MSC/PLS - 09/06/07 - Add changes from Pawhuska for McKesson support
+4 ;
EN1(APSPPATH,APSPFILE) ;
+1 ;IF COMING FROM EN1 SET VARIABLE TO CALL SILENTLY
SET ZTQUEUED=1
EN ;ENTRY POINT TO IMPORT ACTUAL ACQUISTION COST FILE
+1 ;CALLED BY OPTION APSQ IMPORT AAC
+2 LOCK +^TMP("APSAWP11",$JOB):3
IF '$TEST
IF '$DATA(ZTQUEUED)
WRITE !,"CAN'T LOCK-IS SOMEONE ELSE RUNNING THIS OPTION?"
QUIT
+3 IF '$DATA(^APSAMDF)
LOCK -^TMP("APSAWP11",$JOB)
QUIT
+4 KILL ^TMP("APSAWP11",$JOB)
+5 DO CLEAN
+6 IF '$DATA(ZTQUEUED)
WRITE !,"THIS OPTION WILL IMPORT ACTUAL ACQUISTION COST INTO THE AWP MED TRANSACTION FILE"
+7 IF '$DATA(ZTQUEUED)
IF $DATA(^APSAMDF("DATEACC"))
WRITE !,"LAST IMPORT ON DATE ",$$FMTE^XLFDT(^("DATEACC"),1)
+8 ;DIR(0),DIR("A"),DIR("B")
IF '$DATA(ZTQUEUED)
SET Y=$$DIR("Y","DO YOU WISH TO CONTINUE","YES")
+9 IF '$DATA(ZTQUEUED)
IF Y'=1
DO CLEAN
QUIT
+10 SET APSAOS=$PIECE($GET(^AUTTSITE(1,0)),"^",21)
+11 SET APSAPATH=$SELECT($PIECE($GET(^AUTTSITE(1,1)),"^",1)]"":$PIECE(^(1),"^",1),APSAOS=1:"/pub",APSAOS=2:"C:\INETPUB\FTPROOT\PUB",$DATA(APSPPATH):APSPPATH,1:"")
+12 IF '$DATA(ZTQUEUED)
SET Y=$$DIR("F^3:60","ENTER THE PATH TO THE ACTUAL ACQUISTION FILE",APSAPATH)
+13 IF '$DATA(ZTQUEUED)
IF Y="^"
DO CLEAN
QUIT
+14 IF '$DATA(ZTQUEUED)
SET APSAPATH=Y
+15 IF APSAOS=1
IF $EXTRACT(APSAPATH,$LENGTH(APSAPATH))'="/"
SET APSAPATH=APSAPATH_"/"
+16 IF APSAOS=2
IF $EXTRACT(APSAPATH,$LENGTH(APSAPATH))'="\"
SET APSAPATH=APSAPATH_"\"
+17 ;
+18 SET APSAFILE=$SELECT($DATA(APSPFILE):APSPFILE,1:"")
+19 IF '$DATA(ZTQUEUED)
SET Y=$$DIR("F^3:30","ENTER THE NAME OF THE ACTUAL ACQUISTION FILE",APSAFILE)
+20 IF '$DATA(ZTQUEUED)
IF Y="^"
DO CLEAN
QUIT
+21 IF '$DATA(ZTQUEUED)
SET APSAFILE=Y
+22 SET Y=$$LIST^%ZISH(APSAPATH,APSAFILE,.APSAGOT)
+23 SET Y=$$CHECK
+24 IF Y'=1
DO CLEAN
QUIT
+25 SET Y=$$OPEN^%ZISH(APSAPATH,APSAFILE,"R")
+26 IF Y'=0
IF '$DATA(ZTQUEUED)
WRITE !,"HMM... CAN'T OPEN THIS FILE... HELP"
DO CLEAN
QUIT
+27 DO FLETCH
+28 DO CLOSE(IO)
+29 SET ^APSAMDF("DATEACC")=DT
+30 IF '$DATA(ZTQUEUED)
DO REP
+31 DO CLEAN
+32 ;UNLOCK
LOCK -^TMP("APSAWP11",$JOB)
+33 QUIT
DIR(O,A,B) ;
+1 SET DIR(0)=O
SET DIR("A")=A
SET DIR("B")=B
+2 DO ^DIR
+3 IF $DATA(DTIOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))
QUIT "^"
+4 QUIT Y
+5 ;
CLEAN ;
+1 DO EN^XBVK("APSA")
+2 KILL PAGE,END,LINE,DRUGIEN,TMPIEN,APSAIEN
+3 KILL DIR,DIC,DIE
+4 QUIT
+5 ;
CHECK() ;CHECK FOR ONLY ONE FILE (THAT'S NOT NONE OR MORE THAN ONE)
+1 NEW I,CNT
+2 SET CNT=0
SET I=""
+3 FOR
SET I=$ORDER(APSAGOT(I))
IF I=""
QUIT
SET CNT=CNT+1
+4 IF CNT=0
IF '$DATA(ZTQUEUED)
WRITE !,"NO FILE IN PATH "_APSAPATH_" WITH NAME "_APSAFILE_" EXISTS"
+5 IF CNT>1
IF '$DATA(ZTQUEUED)
WRITE !,"MORE THAN ONE FILE EXISTS FOR THIS PATH "_APSAPATH_" AND THIS FILE NAME "_APSAFILE
+6 IF CNT=1
IF '$DATA(ZTQUEUED)
WRITE !,"GOT THE FILE "_APSAFILE
+7 QUIT CNT
+8 ;
TRANS(VAL) ;
+1 ;NO SPACES
SET VAL=$TRANSLATE(VAL," ","")
+2 ;IHS/ITSC/ENM/POC NEXT 5 LINES ADDED 05/14/03
+3 ;NO QUOTES
SET VAL=$TRANSLATE(VAL,"""","")
+4 SET VAL=$TRANSLATE(VAL,"-","")
+5 ;STRIP OUT CONTROL CHARACTERS
NEW PIECE,I,NCONT
+6 SET NCONT=""
FOR I=1:1:$LENGTH(VAL)
Begin DoDot:1
+7 SET PIECE=$EXTRACT(VAL,I)
IF PIECE'?1C
SET NCONT=NCONT_PIECE
End DoDot:1
+8 QUIT NCONT
+9 ;
ERR(VALUE,APSANUM,APSANDC) ;
+1 SET ^TMP("APSAWP11",$JOB,"SORT"," "_APSANDC)=APSANDC_" "_APSANUM_" "_VALUE
+2 QUIT
+3 ;
SORT NEW APSANDC
SET APSANDC=""
+1 ;IN CASE COME HERE FROM OPTION
KILL ^TMP("APSAWP11",$JOB,"ERR")
+2 FOR
SET APSANDC=$ORDER(^TMP("APSAWP11",$JOB,"SORT",APSANDC))
IF APSANDC=""
QUIT
Begin DoDot:1
+3 SET ^(0)=$GET(^TMP("APSAWP11",$JOB,"ERR",0))+1
SET IEN=^(0)
+4 SET ^TMP("APSAWP11",$JOB,"ERR",IEN,0)=^TMP("APSAWP11",$JOB,"SORT",APSANDC)
End DoDot:1
+5 QUIT
+6 ;
CLOSE(IO) ;
+1 DO CLOSE^%ZISH(IO)
+2 QUIT
FLETCH ;
+1 SET APSACNT=0
+2 SET APSASTAT=$SELECT($GET(^%ZOSF("OS"))["OpenM":-1,$GET(^%ZOSF("OS"))["Windows":1,$GET(^%ZOSF("OS"))["UNIX":-1,1:-1)
+3 ;DO I HAVE TO HAVE A TIMEOUT ON A READ??
FOR
USE IO
READ APSANODE:5
IF ($$STATUS^%ZISH=APSASTAT)!'$T
QUIT
Begin DoDot:1
+4 ;IHS/OKCAO/POC 5/7/2003
USE IO(0)
+5 IF APSANODE=""
QUIT
+6 SET APSAQUIT=0
+7 ;ONE TIME INSTEAD OF MANY
SET APSANODE=$$TRANS(APSANODE)
+8 ;NDC NUMBER
SET APSANDC=$PIECE(APSANODE,",",2)
+9 SET APSAAAC=$PIECE(APSANODE,",",4)
+10 SET APSANUM=$PIECE(APSANODE,",",1)
+11 IF APSAAAC']""
DO ERR("NO ACTUAL ACQUISTION COST",APSANUM,APSANDC)
SET APSAQUIT=1
+12 IF APSANDC']""
DO ERR("NO NDC NUMBER",APSANUM,0)
SET APSAQUIT=1
+13 IF $LENGTH(APSANDC)'=11
DO ERR("NDC NOT 11 DIGITS",APSANUM,APSANDC)
SET APSAQUIT=1
+14 IF APSAQUIT
QUIT
+15 SET APSAFNUM=$ORDER(^APSAMDF("B",APSANDC,""))
+16 IF APSAFNUM']""
DO ERR("NO ENTRY IN AWP MED TRANSACTION FILE FOR NDC ",APSANUM,APSANDC)
SET APSAQUIT=1
+17 IF APSAQUIT
QUIT
+18 SET DA=APSAFNUM
+19 SET DIE="^APSAMDF("
+20 SET DR="404///"_APSAAAC
+21 DO ^DIE
+22 SET APSACNT=APSACNT+1
+23 IF '$DATA(ZTQUEUED)
USE 0
WRITE "."
End DoDot:1
+24 IF '$DATA(ZTQUEUED)
USE 0
WRITE !!,"COUNT OF UPDATES IS ",APSACNT
+25 QUIT
+26 ;
REP ;ENTRY POINT TO PRINT OUT THE ERROR ACTUAL ACQUISTION FILE ENTRIES
+1 ;CALLED BY OPTION APSQ PRINT ERRORS FROM IMPORT OF AAC
+2 SET LINE="W !?5,""NDC#"",?18,""AAC#"",?27,""ERR"""
+3 USE 0
WRITE !!,"ENTER THE DEVICE TO PRINT THE ERROR LIST"
+4 SET %ZIS="QM"
DO ^%ZIS
IF POP
QUIT
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 SET ZTRTN="REPORT^APSAWP11"
SET ZTDESC="PRINT ERROR REPORT OF ACUTAL ACQUISTION COST IMPORT"
+7 ;IHS/ITSC/ENM/POC 5/20/2003
SET ZTSAVE("LINE")=""
+8 DO ^%ZTLOAD
DO HOME^%ZIS
KILL IO("Q")
End DoDot:1
QUIT
+9 ;
REPORT ;
+1 ;SORT IT OUT FIRST
DO SORT
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 IF '$DATA(DTIME)
SET DTIME=20
+4 SET (END,PAGE)=0
+5 USE IO
+6 DO @("HDR"_(2-($EXTRACT(IOST,1,2)="C-")))
+7 IF '$DATA(^TMP("APSAWP11",$JOB,"ERR"))
WRITE !,"NO ERRORS IN THE ERROR LOG"
QUIT
+8 SET APSAIEN=0
FOR
SET APSAIEN=$ORDER(^TMP("APSAWP11",$JOB,"ERR",APSAIEN))
IF APSAIEN=""!END
QUIT
Begin DoDot:1
+9 WRITE !?5,^TMP("APSAWP11",$JOB,"ERR",APSAIEN,0)
+10 IF $Y+5>IOSL
DO HDR
End DoDot:1
+11 DO ^%ZISC
+12 DO CLEAN
+13 QUIT
+14 ;
REP1 ;ENTRY POINT FOR NO ACTUAL ACQUISTION COST IN THE DRUG FILE
+1 KILL ^TMP("APSAWP11",$JOB,"ERR1")
+2 DO CLEAN
+3 SET LINE="W !?5,""DRUG#"",?30,""DRUG NAME"""
+4 SET DRUGIEN=0
+5 FOR
SET DRUGIEN=$ORDER(^PSDRUG(DRUGIEN))
IF DRUGIEN'=+DRUGIEN
QUIT
Begin DoDot:1
+6 ;INACTIVE
IF $SELECT('$DATA(^PSDRUG(+DRUGIEN,"I")):0,DT'>^("I"):0,1:1)
QUIT
+7 ;GOT A PRICE
IF $PIECE($GET(^PSDRUG(+DRUGIEN,660)),"^",6)]""
QUIT
+8 SET ^(0)=$GET(^TMP("APSAWP11",$JOB,"ERR1",0))+1
SET TMPIEN=^(0)
+9 SET ^TMP("APSAWP11",$JOB,"ERR1",TMPIEN,0)=$EXTRACT(+DRUGIEN_" ",1,25)_$PIECE(^PSDRUG(+DRUGIEN,0),"^",1)
+10 QUIT
End DoDot:1
+11 USE 0
WRITE !!,"ENTER THE DEVICE TO PRINT THE LIST OF DRUGS WITH NO AAC"
+12 SET %ZIS="QM"
DO ^%ZIS
IF POP
QUIT
+13 IF $DATA(IO("Q"))
Begin DoDot:1
+14 SET ZTRTN="REP1PRT^APSAWP11"
SET ZTDESC="PRINT ERROR REPORT OF ACUTAL ACQUISTION COST IMPORT"
+15 ;IHS/ITSC/ENM/POC 5/20/2003
SET ZTSAVE("LINE")=""
+16 DO ^%ZTLOAD
DO HOME^%ZIS
KILL IO("Q")
End DoDot:1
QUIT
+17 ;
REP1PRT ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 IF '$DATA(DTIME)
SET DTIME=20
+3 SET (END,PAGE)=0
+4 USE IO
+5 DO @("HDR"_(2-($EXTRACT(IOST,1,2)="C-")))
+6 IF '$DATA(^TMP("APSAWP11",$JOB,"ERR1"))
WRITE !,"NO ERRORS IN THE ERROR LOG"
QUIT
+7 SET APSAIEN=0
FOR
SET APSAIEN=$ORDER(^TMP("APSAWP11",$JOB,"ERR1",APSAIEN))
IF APSAIEN=""!END
QUIT
Begin DoDot:1
+8 WRITE !?5,^TMP("APSAWP11",$JOB,"ERR1",APSAIEN,0)
+9 IF $Y+5>IOSL
DO HDR
End DoDot:1
+10 KILL ^TMP("APSAWP11",$JOB,"ERR1")
+11 DO ^%ZISC
+12 DO CLEAN
+13 QUIT
+14 ;
HDR IF $EXTRACT(IOST,1,2)="C-"
WRITE !,"PRESS RETURN TO CONTINUE OR '^' TO QUIT"
READ X:DTIME
SET END='$TEST!(X="^")
IF END
QUIT
HDR1 WRITE @IOF
HDR2 SET APSALOC=$PIECE(^DIC(4,DUZ(2),0),"^")
SET APSALEN=$LENGTH(APSALOC)
+1 SET PAGE=PAGE+1
WRITE ?(IOM-APSALEN/2),APSALOC,?(IOM-12),"PAGE: ",$JUSTIFY(PAGE,3)
+2 XECUTE LINE
+3 QUIT
