APCPSRP2 ; IHS/TUCSON/LAB - PRINT . SECTION AUGUST 14, 1992 ; [ 04/07/99 9:50 AM ]
;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**1**;APR 03, 1998
;IHS/CMI/LAB - patch 1 XTMP
;
APC ;EP
I $Y>(IOSL-10) D HEAD^APCPSRP Q:$D(APCPSR("QUIT"))
VD ;
;
S APCPSR("PTR")=0,APCPSR("T")="By Visit Date:",APCPSR("1")="V DATE",APCPSR("2")="V DATE",APCPSR("WC")=0
D PROC Q:$D(APCPSR("QUIT"))
TYPE ;
S APCPSR("PTR")=0,APCPSR("T")="By Type:",APCPSR("1")="TYPE",APCPSR("2")="TYPEC",APCPSR("WC")=0
D PROC Q:$D(APCPSR("QUIT"))
LOC ;
S APCPSR("PTR")=1,APCPSR("T")="By Location:",APCPSR("1")="LOC",APCPSR("2")="LOCC",APCPSR("WC")=0,APCPSR("GLOBAL")="^DIC(4,",APCPSR("PIECE")=1
D PROC Q:$D(APCPSR("QUIT"))
SC ;
S APCPSR("PTR")=0,APCPSR("T")="By Service Category:",APCPSR("1")="SC",APCPSR("2")="SCC",APCPSR("WC")=0
D PROC Q:$D(APCPSR("QUIT"))
CLINIC ;
S APCPSR("PTR")=0,APCPSR("T")="By Clinic Type:",APCPSR("1")="CLINIC",APCPSR("2")="CLINICC",APCPSR("WC")=0
D PROC Q:$D(APCPSR("QUIT"))
PROVDISC ;
S APCPSR("PTR")=0,APCPSR("T")="By Provider Type (Primary Provider only):",APCPSR("1")="PROV",APCPSR("2")="PROVC",APCPSR("WC")=0
D PROC Q:$D(APCPSR("QUIT"))
EOJ ;
Q
PROC ;
I $Y>(IOSL-9) D HEAD^APCPSRP Q:$D(APCPSR("QUIT"))
W !!?10,APCPSR("T")
S APCPSR("N")=0 F S APCPSR("N")=$O(^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN",APCPSR("2"),APCPSR("N"))) Q:APCPSR("N")=""!($D(APCPSR("QUIT"))) D PROC1
Q
PROC1 ;
I APCPSR("2")["DATE" D PRNT Q
S APCPSR("D")=0 F S APCPSR("D")=$O(^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN",APCPSR("2"),APCPSR("N"),APCPSR("D"))) Q:APCPSR("D")="" D PRNT
Q
PRNTDATE ;
S Y=APCPSR("N") D DD^%DT W !?13,Y,?45,$J(^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN",APCPSR("2"),APCPSR("N")),7) S APCPSR("WC")=APCPSR("WC")+1
Q
PRNT ;
I $Y>(IOSL-5) D HEAD^APCPSRP Q:$D(APCPSR("QUIT")) W !!?10,APCPSR("T") W:APCPSR("WC")>0 " (cont.)"
I APCPSR("1")["V DATE" D PRNTDATE Q
S X=^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN",APCPSR("2"),APCPSR("N"),APCPSR("D"))
I APCPSR("PTR")=1 D PRNTPTR Q
W !?13,APCPSR("D"),?45,$J(X,7) S APCPSR("WC")=APCPSR("WC")+1
Q
PRNTPTR ;
S G=APCPSR("GLOBAL")_APCPSR("D")_")"
W !?13,$P(@G@(0),U,APCPSR("PIECE")),?45,$J(X,7) S APCPSR("WC")=APCPSR("WC")+1
I APCPSR("1")="LOC" W ?55,"(IHS CODE: ",$P(^AUTTLOC(APCPSR("D"),0),U,10),")"
K G
Q
INPT ;EP - PRINT INPATIENT INFO
;
S APCPSR("PTR")=0,APCPSR("T")="By Visit Date:",APCPSR("1")="V DATE HOSP",APCPSR("2")="V DATE HOSP",APCPSR("WC")=0
D PROC Q:$D(APCPSR("QUIT"))
TYPEH ;
S APCPSR("PTR")=0,APCPSR("T")="By Type:",APCPSR("1")="TYPE HOSP",APCPSR("2")="TYPE HOSP CC",APCPSR("WC")=0
D PROC Q:$D(APCPSR("QUIT"))
LOCH ;
S APCPSR("PTR")=1,APCPSR("T")="By Location:",APCPSR("1")="LOC HOSP",APCPSR("2")="LOC HOSP CC",APCPSR("WC")=0,APCPSR("GLOBAL")="^DIC(4,",APCPSR("PIECE")=1
D PROC Q:$D(APCPSR("QUIT"))
SCH ;
S APCPSR("PTR")=0,APCPSR("T")="By Service Category:",APCPSR("1")="SC HOSP",APCPSR("2")="SC HOSP CC",APCPSR("WC")=0
D PROC Q:$D(APCPSR("QUIT"))
PROVH ;
S APCPSR("PTR")=0,APCPSR("T")="By Provider Type (Primary Provider only):",APCPSR("1")="PROV HOSP",APCPSR("2")="PROV HOSP CC",APCPSR("WC")=0
D PROC Q:$D(APCPSR("QUIT"))
Q
APCPSRP2 ; IHS/TUCSON/LAB - PRINT . SECTION AUGUST 14, 1992 ; [ 04/07/99 9:50 AM ]
+1 ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**1**;APR 03, 1998
+2 ;IHS/CMI/LAB - patch 1 XTMP
+3 ;
APC ;EP
+1 IF $Y>(IOSL-10)
DO HEAD^APCPSRP
IF $DATA(APCPSR("QUIT"))
QUIT
VD ;
+1 ;
+2 SET APCPSR("PTR")=0
SET APCPSR("T")="By Visit Date:"
SET APCPSR("1")="V DATE"
SET APCPSR("2")="V DATE"
SET APCPSR("WC")=0
+3 DO PROC
IF $DATA(APCPSR("QUIT"))
QUIT
TYPE ;
+1 SET APCPSR("PTR")=0
SET APCPSR("T")="By Type:"
SET APCPSR("1")="TYPE"
SET APCPSR("2")="TYPEC"
SET APCPSR("WC")=0
+2 DO PROC
IF $DATA(APCPSR("QUIT"))
QUIT
LOC ;
+1 SET APCPSR("PTR")=1
SET APCPSR("T")="By Location:"
SET APCPSR("1")="LOC"
SET APCPSR("2")="LOCC"
SET APCPSR("WC")=0
SET APCPSR("GLOBAL")="^DIC(4,"
SET APCPSR("PIECE")=1
+2 DO PROC
IF $DATA(APCPSR("QUIT"))
QUIT
SC ;
+1 SET APCPSR("PTR")=0
SET APCPSR("T")="By Service Category:"
SET APCPSR("1")="SC"
SET APCPSR("2")="SCC"
SET APCPSR("WC")=0
+2 DO PROC
IF $DATA(APCPSR("QUIT"))
QUIT
CLINIC ;
+1 SET APCPSR("PTR")=0
SET APCPSR("T")="By Clinic Type:"
SET APCPSR("1")="CLINIC"
SET APCPSR("2")="CLINICC"
SET APCPSR("WC")=0
+2 DO PROC
IF $DATA(APCPSR("QUIT"))
QUIT
PROVDISC ;
+1 SET APCPSR("PTR")=0
SET APCPSR("T")="By Provider Type (Primary Provider only):"
SET APCPSR("1")="PROV"
SET APCPSR("2")="PROVC"
SET APCPSR("WC")=0
+2 DO PROC
IF $DATA(APCPSR("QUIT"))
QUIT
EOJ ;
+1 QUIT
PROC ;
+1 IF $Y>(IOSL-9)
DO HEAD^APCPSRP
IF $DATA(APCPSR("QUIT"))
QUIT
+2 WRITE !!?10,APCPSR("T")
+3 SET APCPSR("N")=0
FOR
SET APCPSR("N")=$ORDER(^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN",APCPSR("2"),APCPSR("N")))
IF APCPSR("N")=""!($DATA(APCPSR("QUIT")))
QUIT
DO PROC1
+4 QUIT
PROC1 ;
+1 IF APCPSR("2")["DATE"
DO PRNT
QUIT
+2 SET APCPSR("D")=0
FOR
SET APCPSR("D")=$ORDER(^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN",APCPSR("2"),APCPSR("N"),APCPSR("D")))
IF APCPSR("D")=""
QUIT
DO PRNT
+3 QUIT
PRNTDATE ;
+1 SET Y=APCPSR("N")
DO DD^%DT
WRITE !?13,Y,?45,$JUSTIFY(^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN",APCPSR("2"),APCPSR("N")),7)
SET APCPSR("WC")=APCPSR("WC")+1
+2 QUIT
PRNT ;
+1 IF $Y>(IOSL-5)
DO HEAD^APCPSRP
IF $DATA(APCPSR("QUIT"))
QUIT
WRITE !!?10,APCPSR("T")
IF APCPSR("WC")>0
WRITE " (cont.)"
+2 IF APCPSR("1")["V DATE"
DO PRNTDATE
QUIT
+3 SET X=^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN",APCPSR("2"),APCPSR("N"),APCPSR("D"))
+4 IF APCPSR("PTR")=1
DO PRNTPTR
QUIT
+5 WRITE !?13,APCPSR("D"),?45,$JUSTIFY(X,7)
SET APCPSR("WC")=APCPSR("WC")+1
+6 QUIT
PRNTPTR ;
+1 SET G=APCPSR("GLOBAL")_APCPSR("D")_")"
+2 WRITE !?13,$PIECE(@G@(0),U,APCPSR("PIECE")),?45,$JUSTIFY(X,7)
SET APCPSR("WC")=APCPSR("WC")+1
+3 IF APCPSR("1")="LOC"
WRITE ?55,"(IHS CODE: ",$PIECE(^AUTTLOC(APCPSR("D"),0),U,10),")"
+4 KILL G
+5 QUIT
INPT ;EP - PRINT INPATIENT INFO
+1 ;
+2 SET APCPSR("PTR")=0
SET APCPSR("T")="By Visit Date:"
SET APCPSR("1")="V DATE HOSP"
SET APCPSR("2")="V DATE HOSP"
SET APCPSR("WC")=0
+3 DO PROC
IF $DATA(APCPSR("QUIT"))
QUIT
TYPEH ;
+1 SET APCPSR("PTR")=0
SET APCPSR("T")="By Type:"
SET APCPSR("1")="TYPE HOSP"
SET APCPSR("2")="TYPE HOSP CC"
SET APCPSR("WC")=0
+2 DO PROC
IF $DATA(APCPSR("QUIT"))
QUIT
LOCH ;
+1 SET APCPSR("PTR")=1
SET APCPSR("T")="By Location:"
SET APCPSR("1")="LOC HOSP"
SET APCPSR("2")="LOC HOSP CC"
SET APCPSR("WC")=0
SET APCPSR("GLOBAL")="^DIC(4,"
SET APCPSR("PIECE")=1
+2 DO PROC
IF $DATA(APCPSR("QUIT"))
QUIT
SCH ;
+1 SET APCPSR("PTR")=0
SET APCPSR("T")="By Service Category:"
SET APCPSR("1")="SC HOSP"
SET APCPSR("2")="SC HOSP CC"
SET APCPSR("WC")=0
+2 DO PROC
IF $DATA(APCPSR("QUIT"))
QUIT
PROVH ;
+1 SET APCPSR("PTR")=0
SET APCPSR("T")="By Provider Type (Primary Provider only):"
SET APCPSR("1")="PROV HOSP"
SET APCPSR("2")="PROV HOSP CC"
SET APCPSR("WC")=0
+2 DO PROC
IF $DATA(APCPSR("QUIT"))
QUIT
+3 QUIT
