APCPEPRN ; IHS/TUCSON/LAB - Display TX ERRORS AUGUST 14, 1992 ; [ 12/27/02 10:00 AM ]
;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**6**;APR 03, 1998
;
LOG ;get log entry
W !!,"PCC Data Transmission Error Listing",!
S DIC="^APCPLOG(",DIC(0)="AEMQ" D ^DIC K DIC I Y=-1 W !!,"Goodbye" G XIT
S APCPLOG=+Y S APCPD=APCPLOG
I '$D(^APCPLOG(APCPLOG,51)) W !!,"No TX errors generated on that run." G LOG
LOC ;
K APCPLOCT
S DIR(0)="S^A:ALL Locations/Facilities;S:One SERVICE UNIT'S Locations/Facilities;O:ONE Location/Facility",DIR("A")="Include Visits to Which Location/Facilities",DIR("B")="A"
S DIR("A")="Enter a code indicating what LOCATIONS/FACILITIES are of interest",DIR("B")="O" K DA D ^DIR K DIR,DA
G:$D(DIRUT) LOG
S APCPLOCT=Y
I APCPLOCT="A" K APCPLOCT G ZIS
D @APCPLOCT
G:$D(APCPQ) LOC
ZIS ;call xbdbque
S XBRC="DRIVER^APCPEPRN",XBRP="PRINT^APCPEPRN",XBRX="XIT^APCPEPRN",XBNS="APCP"
D ^XBDBQUE
D XIT
Q
DRIVER ;EP entry point for taskman
S APCPH=$H,APCPJ=$J
K ^XTMP("APCPEPRN",APCPJ,APCPH)
S APCPE=0 F S APCPE=$O(^APCPLOG(APCPLOG,51,APCPE)) Q:APCPE'=+APCPE D
.S APCPE1=$P(^APCPLOG(APCPLOG,51,APCPE,0),U,2),APCPF=$P(APCPE1,";",2),APCPE2=$P(APCPE1,";",1)
.S APCPERR=$P(^APCPLOG(APCPLOG,51,APCPE,0),U,3)
.S APCPV=$P(^APCPLOG(APCPLOG,51,APCPE,0),U,4)
.Q:APCPV=""
.Q:'$D(^AUPNVSIT(APCPV,0))
.I $P(^AUPNVSIT(APCPV,0),U,5)="" Q
.I $P(^AUPNVSIT(APCPV,0),U,6)="" Q
.I $D(APCPLOCT),'$D(APCPLOCT($P(^AUPNVSIT(APCPV,0),U,6))) Q
.S ^XTMP("APCPEPRN",APCPJ,APCPH,"ERRORS",$P(^AUPNVSIT(APCPV,0),U,6),$P(^AUPNVSIT(APCPV,0),U,1),APCPE)=APCPV_U_APCPERR_U_APCPF_U_APCPE2
Q
PRINT ;EP
S APCPPG=0,APCPQ=""
D HEAD
S APCPL=0 F S APCPL=$O(^XTMP("APCPEPRN",APCPJ,APCPH,"ERRORS",APCPL)) Q:APCPL'=+APCPL!(APCPQ) D
.S APCPD="" F S APCPD=$O(^XTMP("APCPEPRN",APCPJ,APCPH,"ERRORS",APCPL,APCPD)) Q:APCPD=""!(APCPQ) D
..S APCPE=0 F S APCPE=$O(^XTMP("APCPEPRN",APCPJ,APCPH,"ERRORS",APCPL,APCPD,APCPE)) Q:APCPE'=+APCPE!(APCPQ) D
...S APCPV=$P(^XTMP("APCPEPRN",APCPJ,APCPH,"ERRORS",APCPL,APCPD,APCPE),U),APCPERR=$P(^(APCPE),U,2),APCPDFN=$P(^AUPNVSIT(APCPV,0),U,5)
...I $Y>(IOSL-5) D HEAD Q:APCPQ
...W !!,$E($$VAL^XBDIQ1(9000010,APCPV,.05),1,20)
...S APCPHRN=$$HRN^AUPNPAT(APCPDFN,APCPL,2)
...I APCPHRN="" S APCPHRN=$$HRN^AUPNPAT(APCPDFN,DUZ(2),2)
...I APCPHRN="" S APCPHRN="?????"
...W ?22,APCPHRN,?34,$$FMTE^XLFDT(APCPD,1),?53,$E($P(^DIC(4,APCPL,0),U,1),1,12),?67,$P(^AUPNVSIT(APCPV,0),U,3),?69,$P(^AUPNVSIT(APCPV,0),U,7),?73,$P(^AUPNVSIT(APCPV,0),U,9)
...W !,?2,"Clinic: ",$$VAL^XBDIQ1(9000010,APCPV,.08)
...W !?2,"Error: ",APCPERR
K ^XTMP("APCPEPRN",APCPJ,APCPH)
Q
XIT ;EP
D EN^XBVK("APCP")
D ^XBFMK
Q
O ;one community
S DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("A")="Which LOCATION: " D ^DIC K DIC
I Y=-1 S APCPQ="" Q
S APCPLOCT(+Y)=""
Q
S ;all communities within APCPSU su
S DIC="^AUTTSU(",DIC("B")=$$VAL^XBDIQ1(9999999.06,DUZ(2),.05),DIC(0)="AEMQ",DIC("A")="Which SERVICE UNIT: " D ^DIC K DIC
I Y=-1 S APCPQ="" Q
W !!,"Gathering up ",$P(^AUTTSU(+Y,0),U),"'s Facilities.."
S X=0 F S X=$O(^AUTTLOC(X)) Q:X'=+X I $P(^AUTTLOC(X,0),U,5)=+Y S APCPLOCT(X)=""
Q
;
HEAD ;EP
G:'APCPPG HEAD1
K DIR I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCPQ=1 Q
HEAD1 ;
W:$D(IOF) @IOF S APCPPG=APCPPG+1
W !?35,$$FMTE^XLFDT(DT),?70,"Page ",APCPPG
S X="***** PCC EXPORT ERROR LISTING *****" W !,?((80-$L(X))/2),X
S X="Log Entry: "_APCPLOG_" Dates: "_$$FMTE^XLFDT($P(^APCPLOG(APCPLOG,0),U,1))_" to "_$$FMTE^XLFDT($P(^APCPLOG(APCPLOG,0),U,2)) W !,$$CTR(X,80),!
I '$D(APCPLOCT) S X="ALL Locations/Facilities Included" W $$CTR(X,80),!
I $D(APCPLOCT) S X="Selected Facilities/Locations Included" W $$CTR(X,80),!
W !,"Name",?22,"HRN",?34,"Visit Date/Time",?53,"Location",?66,"TY",?69,"SC",?73,"DEP"
W !,$TR($J("",80)," ","-")
Q
LBLK(V,L) ;left blank fill
NEW %,I
S %=$L(V),Z=L-% F I=1:1:Z S V=" "_V
Q V
RBLK(V,L) ;EP right blank fill
NEW %,I
S %=$L(V),Z=L-% F I=1:1:Z S V=V_" "
Q V
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR(0)="E" D ^DIR
Q
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
APCPEPRN ; IHS/TUCSON/LAB - Display TX ERRORS AUGUST 14, 1992 ; [ 12/27/02 10:00 AM ]
+1 ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**6**;APR 03, 1998
+2 ;
LOG ;get log entry
+1 WRITE !!,"PCC Data Transmission Error Listing",!
+2 SET DIC="^APCPLOG("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
IF Y=-1
WRITE !!,"Goodbye"
GOTO XIT
+3 SET APCPLOG=+Y
SET APCPD=APCPLOG
+4 IF '$DATA(^APCPLOG(APCPLOG,51))
WRITE !!,"No TX errors generated on that run."
GOTO LOG
LOC ;
+1 KILL APCPLOCT
+2 SET DIR(0)="S^A:ALL Locations/Facilities;S:One SERVICE UNIT'S Locations/Facilities;O:ONE Location/Facility"
SET DIR("A")="Include Visits to Which Location/Facilities"
SET DIR("B")="A"
+3 SET DIR("A")="Enter a code indicating what LOCATIONS/FACILITIES are of interest"
SET DIR("B")="O"
KILL DA
DO ^DIR
KILL DIR,DA
+4 IF $DATA(DIRUT)
GOTO LOG
+5 SET APCPLOCT=Y
+6 IF APCPLOCT="A"
KILL APCPLOCT
GOTO ZIS
+7 DO @APCPLOCT
+8 IF $DATA(APCPQ)
GOTO LOC
ZIS ;call xbdbque
+1 SET XBRC="DRIVER^APCPEPRN"
SET XBRP="PRINT^APCPEPRN"
SET XBRX="XIT^APCPEPRN"
SET XBNS="APCP"
+2 DO ^XBDBQUE
+3 DO XIT
+4 QUIT
DRIVER ;EP entry point for taskman
+1 SET APCPH=$HOROLOG
SET APCPJ=$JOB
+2 KILL ^XTMP("APCPEPRN",APCPJ,APCPH)
+3 SET APCPE=0
FOR
SET APCPE=$ORDER(^APCPLOG(APCPLOG,51,APCPE))
IF APCPE'=+APCPE
QUIT
Begin DoDot:1
+4 SET APCPE1=$PIECE(^APCPLOG(APCPLOG,51,APCPE,0),U,2)
SET APCPF=$PIECE(APCPE1,";",2)
SET APCPE2=$PIECE(APCPE1,";",1)
+5 SET APCPERR=$PIECE(^APCPLOG(APCPLOG,51,APCPE,0),U,3)
+6 SET APCPV=$PIECE(^APCPLOG(APCPLOG,51,APCPE,0),U,4)
+7 IF APCPV=""
QUIT
+8 IF '$DATA(^AUPNVSIT(APCPV,0))
QUIT
+9 IF $PIECE(^AUPNVSIT(APCPV,0),U,5)=""
QUIT
+10 IF $PIECE(^AUPNVSIT(APCPV,0),U,6)=""
QUIT
+11 IF $DATA(APCPLOCT)
IF '$DATA(APCPLOCT($PIECE(^AUPNVSIT(APCPV,0),U,6)))
QUIT
+12 SET ^XTMP("APCPEPRN",APCPJ,APCPH,"ERRORS",$PIECE(^AUPNVSIT(APCPV,0),U,6),$PIECE(^AUPNVSIT(APCPV,0),U,1),APCPE)=APCPV_U_APCPERR_U_APCPF_U_APCPE2
End DoDot:1
+13 QUIT
PRINT ;EP
+1 SET APCPPG=0
SET APCPQ=""
+2 DO HEAD
+3 SET APCPL=0
FOR
SET APCPL=$ORDER(^XTMP("APCPEPRN",APCPJ,APCPH,"ERRORS",APCPL))
IF APCPL'=+APCPL!(APCPQ)
QUIT
Begin DoDot:1
+4 SET APCPD=""
FOR
SET APCPD=$ORDER(^XTMP("APCPEPRN",APCPJ,APCPH,"ERRORS",APCPL,APCPD))
IF APCPD=""!(APCPQ)
QUIT
Begin DoDot:2
+5 SET APCPE=0
FOR
SET APCPE=$ORDER(^XTMP("APCPEPRN",APCPJ,APCPH,"ERRORS",APCPL,APCPD,APCPE))
IF APCPE'=+APCPE!(APCPQ)
QUIT
Begin DoDot:3
+6 SET APCPV=$PIECE(^XTMP("APCPEPRN",APCPJ,APCPH,"ERRORS",APCPL,APCPD,APCPE),U)
SET APCPERR=$PIECE(^(APCPE),U,2)
SET APCPDFN=$PIECE(^AUPNVSIT(APCPV,0),U,5)
+7 IF $Y>(IOSL-5)
DO HEAD
IF APCPQ
QUIT
+8 WRITE !!,$EXTRACT($$VAL^XBDIQ1(9000010,APCPV,.05),1,20)
+9 SET APCPHRN=$$HRN^AUPNPAT(APCPDFN,APCPL,2)
+10 IF APCPHRN=""
SET APCPHRN=$$HRN^AUPNPAT(APCPDFN,DUZ(2),2)
+11 IF APCPHRN=""
SET APCPHRN="?????"
+12 WRITE ?22,APCPHRN,?34,$$FMTE^XLFDT(APCPD,1),?53,$EXTRACT($PIECE(^DIC(4,APCPL,0),U,1),1,12),?67,$PIECE(^AUPNVSIT(APCPV,0),U,3),?69,$PIECE(^AUPNVSIT(APCPV,0),U,7),?73,$PIECE(^AUPNVSIT(APCPV,0),U,9)
+13 WRITE !,?2,"Clinic: ",$$VAL^XBDIQ1(9000010,APCPV,.08)
+14 WRITE !?2,"Error: ",APCPERR
End DoDot:3
End DoDot:2
End DoDot:1
+15 KILL ^XTMP("APCPEPRN",APCPJ,APCPH)
+16 QUIT
XIT ;EP
+1 DO EN^XBVK("APCP")
+2 DO ^XBFMK
+3 QUIT
O ;one community
+1 SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
SET DIC("A")="Which LOCATION: "
DO ^DIC
KILL DIC
+2 IF Y=-1
SET APCPQ=""
QUIT
+3 SET APCPLOCT(+Y)=""
+4 QUIT
S ;all communities within APCPSU su
+1 SET DIC="^AUTTSU("
SET DIC("B")=$$VAL^XBDIQ1(9999999.06,DUZ(2),.05)
SET DIC(0)="AEMQ"
SET DIC("A")="Which SERVICE UNIT: "
DO ^DIC
KILL DIC
+2 IF Y=-1
SET APCPQ=""
QUIT
+3 WRITE !!,"Gathering up ",$PIECE(^AUTTSU(+Y,0),U),"'s Facilities.."
+4 SET X=0
FOR
SET X=$ORDER(^AUTTLOC(X))
IF X'=+X
QUIT
IF $PIECE(^AUTTLOC(X,0),U,5)=+Y
SET APCPLOCT(X)=""
+5 QUIT
+6 ;
HEAD ;EP
+1 IF 'APCPPG
GOTO HEAD1
+2 KILL DIR
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCPQ=1
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET APCPPG=APCPPG+1
+2 WRITE !?35,$$FMTE^XLFDT(DT),?70,"Page ",APCPPG
+3 SET X="***** PCC EXPORT ERROR LISTING *****"
WRITE !,?((80-$LENGTH(X))/2),X
+4 SET X="Log Entry: "_APCPLOG_" Dates: "_$$FMTE^XLFDT($PIECE(^APCPLOG(APCPLOG,0),U,1))_" to "_$$FMTE^XLFDT($PIECE(^APCPLOG(APCPLOG,0),U,2))
WRITE !,$$CTR(X,80),!
+5 IF '$DATA(APCPLOCT)
SET X="ALL Locations/Facilities Included"
WRITE $$CTR(X,80),!
+6 IF $DATA(APCPLOCT)
SET X="Selected Facilities/Locations Included"
WRITE $$CTR(X,80),!
+7 WRITE !,"Name",?22,"HRN",?34,"Visit Date/Time",?53,"Location",?66,"TY",?69,"SC",?73,"DEP"
+8 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+9 QUIT
LBLK(V,L) ;left blank fill
+1 NEW %,I
+2 SET %=$LENGTH(V)
SET Z=L-%
FOR I=1:1:Z
SET V=" "_V
+3 QUIT V
RBLK(V,L) ;EP right blank fill
+1 NEW %,I
+2 SET %=$LENGTH(V)
SET Z=L-%
FOR I=1:1:Z
SET V=V_" "
+3 QUIT V
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
