APCPRPS1 ; IHS/TUCSON/LAB - AMBULATORY OPERATIONS SUMMARY AUGUST 14, 1992 ; [ 09/08/99 7:41 AM ]
;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**1,3**;APR 03, 1998
;
;IHS/CMI/LAB - patch 1 added $G at CHKDISC+6 08/08/98 XTMP
START ;
S APCPRPS("80D")="-------------------------------------------------------------------------------"
S APCPRPS("RUN SITE")=+^APCPSITE(1,0)
S APCPRPS(" PRINT")=$P(^DIC(4,APCPRPS("RUN SITE"),0),U)
S Y=$P(^APCPLOG(APCPRPS("LOG"),0),U,3) D DD^%DT S APCPRPS("RUN DATE")=Y
S APCPRPS("PG")=0
D HEAD
I '$D(^XTMP("APCPRPS",APCPJOB,APCPBTH)) W !!,"No visits skipped.",! G EOJ
K APCPRPS("QUIT")
D PROC
G:$D(APCPRPS("QUIT")) EOJ
W !!,"TOTAL VISITS SKIPPED: ",^XTMP("APCPRPS",APCPJOB,APCPBTH,"GEN","TOTAL")
I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report. HIT RETURN" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
W:$D(IOF) @IOF
EOJ ;
K ^XTMP("APCPRPS",APCPJOB,APCPBTH)
Q
PROC ;
S APCPRPS("V")=0 F S APCPRPS("V")=$O(^XTMP("APCPRPS",APCPJOB,APCPBTH,"VISITS",APCPRPS("V"))) Q:APCPRPS("V")'=+APCPRPS("V")!($D(APCPRPS("QUIT"))) D PRINT
Q
PRINT ;
I $Y>(IOSL-6) D HEAD Q:$D(APCPRPS("QUIT"))
S APCPRPS("VR")=^AUPNVSIT(APCPRPS("V"),0),APCPRPS("V LOC")=$P(APCPRPS("VR"),U,6),APCPRPS("V LOC")=$E($P(^AUTTLOC(APCPRPS("V LOC"),0),U,2),1,10),APCPRPS("TYPE")=$P(APCPRPS("VR"),U,3),APCPRPS("SC")=$P(APCPRPS("VR"),U,7)
S APCPRPS("ERROR")="UNKNOWN"
CLINIC ;
S APCPRPS("CLINIC")=$P(^AUPNVSIT(APCPRPS("V"),0),U,8) I APCPRPS("CLINIC")="" S APCPRPS("CLINIC")="--" G HRN
S APCPRPS("CLINIC")=$P(^DIC(40.7,APCPRPS("CLINIC"),0),U,2)
HRN S APCPRPS("PAT DFN")=$P(APCPRPS("VR"),U,5),APCPRPS("HRN")=""
S:$D(^AUPNPAT(APCPRPS("PAT DFN"),41,$P(APCPRPS("VR"),U,6),0)) APCPRPS("HRN")=$P(^AUTTLOC($P(APCPRPS("VR"),U,6),0),U,7)_$P(^AUPNPAT(APCPRPS("PAT DFN"),41,$P(APCPRPS("VR"),U,6),0),U,2)
I APCPRPS("HRN")="" S:$D(^AUPNPAT(APCPRPS("PAT DFN"),41,APCPRPS("RUN SITE"),0)) APCPRPS("HRN")=$P(^AUTTLOC(APCPRPS("RUN SITE"),0),U,7)_$P(^AUPNPAT(APCPRPS("PAT DFN"),41,APCPRPS("RUN SITE"),0),U,2)
S:APCPRPS("HRN")="" APCPRPS("HRN")="???"
I $P(^AUPNVSIT(APCPRPS("V"),0),U,11) S APCPRPS("ERROR")="VISIT IS DELETED" G VD
I $P(^DPT(APCPRPS("PAT DFN"),0),U)["DEMO,PATIENT" S APCPRPS("ERROR")="VISIT IS FOR DEMO,PATIENT" G VD
TYPE ;I "CV"[$P(^AUPNVSIT(APCPRPS("V"),0),U,3) S APCPRPS("ERROR")="NON APC VISIT TYPE" G VD ;IHS/CMI/LAB
SC I "E"[$P(^AUPNVSIT(APCPRPS("V"),0),U,7) S APCPRPS("ERROR")="EVENT VISIT" G VD ;IHS/CMI/LAB
CHKCL ;
;I APCPRPS("CLINIC")="--" G CHKCHA
;S X="C"_APCPRPS("CLINIC") I $T(@X)]"" S APCPRPS("ERROR")="NON APC CLINIC CODE" G VD
CHKCHA ;check to see if generated cha but not apc
;G:'$D(^AUPNVPRV("AD",APCPRPS("V"))) ERROR
;I $P(^APCPLOG(APCPRPS("LOG"),21,APCPRPS("V"),0),U,6) S APCPRPS("ERROR")="CHA RECORD BUT NO APC" G VD
;S (X,C)=0 F S X=$O(^AUPNVPRV("AD",APCPRPS("V"),X)) Q:X'=+X I $P(^AUPNVPRV(X,0),U,4)="P" S C=C+1,APCPRPS("AP")=$P(^(0),U)
CHKDISC ;
;I C=0!(C>1) G ERROR
;I '$P($G(^AUTTSITE(1,0)),U,22) D
;.S APCPRPS("DPTR")=$P(^DIC(6,APCPRPS("AP"),0),U,4)
;.I APCPRPS("DPTR")="" S APCPRPS("ERROR")="NO PROV DISCIPLINE" G VD
;.I '$D(^DIC(7,APCPRPS("DPTR"),9999999)) S APCPRPS("ERROR")="NO PROV DISC CODE" G VD
;.S APCPRPS("DISC")=$P($G(^DIC(7,APCPRPS("DPTR"),9999999)),U) I APCPRPS("DISC")="" S APCPRPS("ERROR")="NO PROV DISC CODE IN DIC7" G VD ;CMI;.TUCSON/LAB added $G to prevent subscript/undef patch 1
;.S APCPRPS("LOCC")=$E($P(^AUTTLOC($P(APCPRPS("VR"),U,6),0),U,10),5,6)
;.I (APCPRPS("DISC")=13!(APCPRPS("DISC")=32))&((APCPRPS("LOCC")>49)!(APCPRPS("LOCC")'=+APCPRPS("LOCC"))) S APCPRPS("ERROR")="PHN VISIT NON-CLINIC" G VD
;
;I $P($G(^AUTTSITE(1,0)),U,22) D
;.S APCPRPS("DPTR")=$P($G(^VA(200,APCPRPS("AP"),"PS")),U,5)
;.I APCPRPS("DPTR")="" S APCPRPS("ERROR")="NO PROV DISCIPLINE" G VD
;.I '$D(^DIC(7,APCPRPS("DPTR"),9999999)) S APCPRPS("ERROR")="NO PROV DISC CODE" G VD
;.S APCPRPS("DISC")=$P(^DIC(7,APCPRPS("DPTR"),9999999),U) I APCPRPS("ERROR")="NO PROV DISC CODE" G VD
;.S APCPRPS("LOCC")=$E($P(^AUTTLOC($P(APCPRPS("VR"),U,6),0),U,10),5,6)
;.I (APCPRPS("DISC")=13!(APCPRPS("DISC")=32))&((APCPRPS("LOCC")>49)!(APCPRPS("LOCC")'=+APCPRPS("LOCC"))) S APCPRPS("ERROR")="PHN VISIT NON-CLINIC" G VD
ERROR I $D(^APCPLOG(APCPRPS("LOG"),51,"AC",APCPRPS("V"))) D G VD
.S APCPRPS("ERROR")=$O(^APCPLOG(APCPRPS("LOG"),51,"AC",APCPRPS("V"),"")),APCPRPS("ERROR")=$E($P(^APCPLOG(APCPRPS("LOG"),51,APCPRPS("ERROR"),0),U,3),1,25)
I $P(^AUPNVSIT(APCPRPS("V"),0),U,3)="C",'$D(^AUPNVPRV("AD",APCPRPS("V"))) S APCPRPS("ERROR")="INCOMPLETE CHS VISIT" G VD
I $P(^AUPNVSIT(APCPRPS("V"),0),U,3)="C",'$D(^AUPNVPOV("AD",APCPRPS("V"))) S APCPRPS("ERROR")="INCOMPLETE CHS VISIT" G VD
I $P(^AUPNVSIT(APCPRPS("V"),0),U,7)="I",'$D(^AUPNVPRV("AD",APCPRPS("V"))) S APCPRPS("ERROR")="INCOMPLETE IN HOSPITAL VISIT" G VD
I $P(^AUPNVSIT(APCPRPS("V"),0),U,7)="I",'$D(^AUPNVPOV("AD",APCPRPS("V"))) S APCPRPS("ERROR")="INCOMPLETE IN HOSPITAL VISIT" G VD
VD ;
S Y=+APCPRPS("VR") X ^DD("DD") S APCPRPS("RD")=Y
PRN ;
W !,APCPRPS("HRN"),?10,APCPRPS("RD"),?28,APCPRPS("V LOC"),?40,APCPRPS("TYPE"),?44,$E(APCPRPS("SC"),1,15),?47,$E(APCPRPS("CLINIC"),1,10),?52,APCPRPS("ERROR")
Q
HEAD I 'APCPRPS("PG") G HEAD1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCPRPS("QUIT")="" Q
HEAD1 ;
W:$D(IOF) @IOF S APCPRPS("PG")=APCPRPS("PG")+1
S APCPRPS("LENG")=30+$L(APCPRPS(" PRINT"))
W !,"Report Run Date: ",$$FMTE^XLFDT(DT),?70,"Page ",APCPRPS("PG")
W !!?((80-APCPRPS("LENG"))/2),"PCC DATA TRANSMISSION FOR ",APCPRPS(" PRINT")
W !?24,"Listing of VISITS NOT Exported"
W !?18,"Date Export Run: ",APCPRPS("RUN DATE")
W !?8,"Visits Processed for Posting Dates: ",APCPRPS("PRINT BEGIN")," to ",APCPRPS("PRINT END")
W !!,APCPRPS("80D"),!," HRN ",?10,"VISIT DATE/TIME",?28,"LOCATION",?39,"TYPE",?44,"SC",?45," CLIN",?55,"ERROR MESSAGE",!,APCPRPS("80D"),!
Q
C42 ;;
C51 ;;
C52 ;;
C53 ;;
C54 ;;
C56 ;;
C60 ;;
C68 ;;
APCPRPS1 ; IHS/TUCSON/LAB - AMBULATORY OPERATIONS SUMMARY AUGUST 14, 1992 ; [ 09/08/99 7:41 AM ]
+1 ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**1,3**;APR 03, 1998
+2 ;
+3 ;IHS/CMI/LAB - patch 1 added $G at CHKDISC+6 08/08/98 XTMP
START ;
+1 SET APCPRPS("80D")="-------------------------------------------------------------------------------"
+2 SET APCPRPS("RUN SITE")=+^APCPSITE(1,0)
+3 SET APCPRPS(" PRINT")=$PIECE(^DIC(4,APCPRPS("RUN SITE"),0),U)
+4 SET Y=$PIECE(^APCPLOG(APCPRPS("LOG"),0),U,3)
DO DD^%DT
SET APCPRPS("RUN DATE")=Y
+5 SET APCPRPS("PG")=0
+6 DO HEAD
+7 IF '$DATA(^XTMP("APCPRPS",APCPJOB,APCPBTH))
WRITE !!,"No visits skipped.",!
GOTO EOJ
+8 KILL APCPRPS("QUIT")
+9 DO PROC
+10 IF $DATA(APCPRPS("QUIT"))
GOTO EOJ
+11 WRITE !!,"TOTAL VISITS SKIPPED: ",^XTMP("APCPRPS",APCPJOB,APCPBTH,"GEN","TOTAL")
+12 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="EO"
SET DIR("A")="End of report. HIT RETURN"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+13 IF $DATA(IOF)
WRITE @IOF
EOJ ;
+1 KILL ^XTMP("APCPRPS",APCPJOB,APCPBTH)
+2 QUIT
PROC ;
+1 SET APCPRPS("V")=0
FOR
SET APCPRPS("V")=$ORDER(^XTMP("APCPRPS",APCPJOB,APCPBTH,"VISITS",APCPRPS("V")))
IF APCPRPS("V")'=+APCPRPS("V")!($DATA(APCPRPS("QUIT")))
QUIT
DO PRINT
+2 QUIT
PRINT ;
+1 IF $Y>(IOSL-6)
DO HEAD
IF $DATA(APCPRPS("QUIT"))
QUIT
+2 SET APCPRPS("VR")=^AUPNVSIT(APCPRPS("V"),0)
SET APCPRPS("V LOC")=$PIECE(APCPRPS("VR"),U,6)
SET APCPRPS("V LOC")=$EXTRACT($PIECE(^AUTTLOC(APCPRPS("V LOC"),0),U,2),1,10)
SET APCPRPS("TYPE")=$PIECE(APCPRPS("VR"),U,3)
SET APCPRPS("SC")=$PIECE(APCPRPS("VR"),U,7)
+3 SET APCPRPS("ERROR")="UNKNOWN"
CLINIC ;
+1 SET APCPRPS("CLINIC")=$PIECE(^AUPNVSIT(APCPRPS("V"),0),U,8)
IF APCPRPS("CLINIC")=""
SET APCPRPS("CLINIC")="--"
GOTO HRN
+2 SET APCPRPS("CLINIC")=$PIECE(^DIC(40.7,APCPRPS("CLINIC"),0),U,2)
HRN SET APCPRPS("PAT DFN")=$PIECE(APCPRPS("VR"),U,5)
SET APCPRPS("HRN")=""
+1 IF $DATA(^AUPNPAT(APCPRPS("PAT DFN"),41,$PIECE(APCPRPS("VR"),U,6),0))
SET APCPRPS("HRN")=$PIECE(^AUTTLOC($PIECE(APCPRPS("VR"),U,6),0),U,7)_$PIECE(^AUPNPAT(APCPRPS("PAT DFN"),41,$PIECE(APCPRPS("VR"),U,6),0),U,2)
+2 IF APCPRPS("HRN")=""
IF $DATA(^AUPNPAT(APCPRPS("PAT DFN"),41,APCPRPS("RUN SITE"),0))
SET APCPRPS("HRN")=$PIECE(^AUTTLOC(APCPRPS("RUN SITE"),0),U,7)_$PIECE(^AUPNPAT(APCPRPS("PAT DFN"),41,APCPRPS("RUN SITE"),0),U,2)
+3 IF APCPRPS("HRN")=""
SET APCPRPS("HRN")="???"
+4 IF $PIECE(^AUPNVSIT(APCPRPS("V"),0),U,11)
SET APCPRPS("ERROR")="VISIT IS DELETED"
GOTO VD
+5 IF $PIECE(^DPT(APCPRPS("PAT DFN"),0),U)["DEMO,PATIENT"
SET APCPRPS("ERROR")="VISIT IS FOR DEMO,PATIENT"
GOTO VD
TYPE ;I "CV"[$P(^AUPNVSIT(APCPRPS("V"),0),U,3) S APCPRPS("ERROR")="NON APC VISIT TYPE" G VD ;IHS/CMI/LAB
SC ;IHS/CMI/LAB
IF "E"[$PIECE(^AUPNVSIT(APCPRPS("V"),0),U,7)
SET APCPRPS("ERROR")="EVENT VISIT"
GOTO VD
CHKCL ;
+1 ;I APCPRPS("CLINIC")="--" G CHKCHA
+2 ;S X="C"_APCPRPS("CLINIC") I $T(@X)]"" S APCPRPS("ERROR")="NON APC CLINIC CODE" G VD
CHKCHA ;check to see if generated cha but not apc
+1 ;G:'$D(^AUPNVPRV("AD",APCPRPS("V"))) ERROR
+2 ;I $P(^APCPLOG(APCPRPS("LOG"),21,APCPRPS("V"),0),U,6) S APCPRPS("ERROR")="CHA RECORD BUT NO APC" G VD
+3 ;S (X,C)=0 F S X=$O(^AUPNVPRV("AD",APCPRPS("V"),X)) Q:X'=+X I $P(^AUPNVPRV(X,0),U,4)="P" S C=C+1,APCPRPS("AP")=$P(^(0),U)
CHKDISC ;
+1 ;I C=0!(C>1) G ERROR
+2 ;I '$P($G(^AUTTSITE(1,0)),U,22) D
+3 ;.S APCPRPS("DPTR")=$P(^DIC(6,APCPRPS("AP"),0),U,4)
+4 ;.I APCPRPS("DPTR")="" S APCPRPS("ERROR")="NO PROV DISCIPLINE" G VD
+5 ;.I '$D(^DIC(7,APCPRPS("DPTR"),9999999)) S APCPRPS("ERROR")="NO PROV DISC CODE" G VD
+6 ;.S APCPRPS("DISC")=$P($G(^DIC(7,APCPRPS("DPTR"),9999999)),U) I APCPRPS("DISC")="" S APCPRPS("ERROR")="NO PROV DISC CODE IN DIC7" G VD ;CMI;.TUCSON/LAB added $G to prevent subscript/undef patch 1
+7 ;.S APCPRPS("LOCC")=$E($P(^AUTTLOC($P(APCPRPS("VR"),U,6),0),U,10),5,6)
+8 ;.I (APCPRPS("DISC")=13!(APCPRPS("DISC")=32))&((APCPRPS("LOCC")>49)!(APCPRPS("LOCC")'=+APCPRPS("LOCC"))) S APCPRPS("ERROR")="PHN VISIT NON-CLINIC" G VD
+9 ;
+10 ;I $P($G(^AUTTSITE(1,0)),U,22) D
+11 ;.S APCPRPS("DPTR")=$P($G(^VA(200,APCPRPS("AP"),"PS")),U,5)
+12 ;.I APCPRPS("DPTR")="" S APCPRPS("ERROR")="NO PROV DISCIPLINE" G VD
+13 ;.I '$D(^DIC(7,APCPRPS("DPTR"),9999999)) S APCPRPS("ERROR")="NO PROV DISC CODE" G VD
+14 ;.S APCPRPS("DISC")=$P(^DIC(7,APCPRPS("DPTR"),9999999),U) I APCPRPS("ERROR")="NO PROV DISC CODE" G VD
+15 ;.S APCPRPS("LOCC")=$E($P(^AUTTLOC($P(APCPRPS("VR"),U,6),0),U,10),5,6)
+16 ;.I (APCPRPS("DISC")=13!(APCPRPS("DISC")=32))&((APCPRPS("LOCC")>49)!(APCPRPS("LOCC")'=+APCPRPS("LOCC"))) S APCPRPS("ERROR")="PHN VISIT NON-CLINIC" G VD
ERROR IF $DATA(^APCPLOG(APCPRPS("LOG"),51,"AC",APCPRPS("V")))
Begin DoDot:1
+1 SET APCPRPS("ERROR")=$ORDER(^APCPLOG(APCPRPS("LOG"),51,"AC",APCPRPS("V"),""))
SET APCPRPS("ERROR")=$EXTRACT($PIECE(^APCPLOG(APCPRPS("LOG"),51,APCPRPS("ERROR"),0),U,3),1,25)
End DoDot:1
GOTO VD
+2 IF $PIECE(^AUPNVSIT(APCPRPS("V"),0),U,3)="C"
IF '$DATA(^AUPNVPRV("AD",APCPRPS("V")))
SET APCPRPS("ERROR")="INCOMPLETE CHS VISIT"
GOTO VD
+3 IF $PIECE(^AUPNVSIT(APCPRPS("V"),0),U,3)="C"
IF '$DATA(^AUPNVPOV("AD",APCPRPS("V")))
SET APCPRPS("ERROR")="INCOMPLETE CHS VISIT"
GOTO VD
+4 IF $PIECE(^AUPNVSIT(APCPRPS("V"),0),U,7)="I"
IF '$DATA(^AUPNVPRV("AD",APCPRPS("V")))
SET APCPRPS("ERROR")="INCOMPLETE IN HOSPITAL VISIT"
GOTO VD
+5 IF $PIECE(^AUPNVSIT(APCPRPS("V"),0),U,7)="I"
IF '$DATA(^AUPNVPOV("AD",APCPRPS("V")))
SET APCPRPS("ERROR")="INCOMPLETE IN HOSPITAL VISIT"
GOTO VD
VD ;
+1 SET Y=+APCPRPS("VR")
XECUTE ^DD("DD")
SET APCPRPS("RD")=Y
PRN ;
+1 WRITE !,APCPRPS("HRN"),?10,APCPRPS("RD"),?28,APCPRPS("V LOC"),?40,APCPRPS("TYPE"),?44,$EXTRACT(APCPRPS("SC"),1,15),?47,$EXTRACT(APCPRPS("CLINIC"),1,10),?52,APCPRPS("ERROR")
+2 QUIT
HEAD IF 'APCPRPS("PG")
GOTO HEAD1
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCPRPS("QUIT")=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET APCPRPS("PG")=APCPRPS("PG")+1
+2 SET APCPRPS("LENG")=30+$LENGTH(APCPRPS(" PRINT"))
+3 WRITE !,"Report Run Date: ",$$FMTE^XLFDT(DT),?70,"Page ",APCPRPS("PG")
+4 WRITE !!?((80-APCPRPS("LENG"))/2),"PCC DATA TRANSMISSION FOR ",APCPRPS(" PRINT")
+5 WRITE !?24,"Listing of VISITS NOT Exported"
+6 WRITE !?18,"Date Export Run: ",APCPRPS("RUN DATE")
+7 WRITE !?8,"Visits Processed for Posting Dates: ",APCPRPS("PRINT BEGIN")," to ",APCPRPS("PRINT END")
+8 WRITE !!,APCPRPS("80D"),!," HRN ",?10,"VISIT DATE/TIME",?28,"LOCATION",?39,"TYPE",?44,"SC",?45," CLIN",?55,"ERROR MESSAGE",!,APCPRPS("80D"),!
+9 QUIT
C42 ;;
C51 ;;
C52 ;;
C53 ;;
C54 ;;
C56 ;;
C60 ;;
C68 ;;
