- 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
