- 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 ;----------
