- 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
