Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCPRPS1

APCPRPS1.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;IHS/CMI/LAB - patch 1 added $G at CHKDISC+6 08/08/98 XTMP
  1. START ;
  1.  S APCPRPS("80D")="-------------------------------------------------------------------------------"
  1.  S APCPRPS("RUN SITE")=+^APCPSITE(1,0)
  1.  S APCPRPS(" PRINT")=$P(^DIC(4,APCPRPS("RUN SITE"),0),U)
  1.  S Y=$P(^APCPLOG(APCPRPS("LOG"),0),U,3) D DD^%DT S APCPRPS("RUN DATE")=Y
  1.  S APCPRPS("PG")=0
  1.  D HEAD
  1.  I '$D(^XTMP("APCPRPS",APCPJOB,APCPBTH)) W !!,"No visits skipped.",! G EOJ
  1.  K APCPRPS("QUIT")
  1.  D PROC
  1.  G:$D(APCPRPS("QUIT")) EOJ
  1.  W !!,"TOTAL VISITS SKIPPED:  ",^XTMP("APCPRPS",APCPJOB,APCPBTH,"GEN","TOTAL")
  1.  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
  1.  W:$D(IOF) @IOF
  1. EOJ ;
  1.  K ^XTMP("APCPRPS",APCPJOB,APCPBTH)
  1.  Q
  1. PROC ;
  1.  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
  1.  Q
  1. PRINT ;
  1.  I $Y>(IOSL-6) D HEAD Q:$D(APCPRPS("QUIT"))
  1.  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)
  1.  S APCPRPS("ERROR")="UNKNOWN"
  1. CLINIC ;
  1.  S APCPRPS("CLINIC")=$P(^AUPNVSIT(APCPRPS("V"),0),U,8) I APCPRPS("CLINIC")="" S APCPRPS("CLINIC")="--" G HRN
  1.  S APCPRPS("CLINIC")=$P(^DIC(40.7,APCPRPS("CLINIC"),0),U,2)
  1. HRN S APCPRPS("PAT DFN")=$P(APCPRPS("VR"),U,5),APCPRPS("HRN")=""
  1.  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)
  1.  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)
  1.  S:APCPRPS("HRN")="" APCPRPS("HRN")="???"
  1.  I $P(^AUPNVSIT(APCPRPS("V"),0),U,11) S APCPRPS("ERROR")="VISIT IS DELETED" G VD
  1.  I $P(^DPT(APCPRPS("PAT DFN"),0),U)["DEMO,PATIENT" S APCPRPS("ERROR")="VISIT IS FOR DEMO,PATIENT" G VD
  1. TYPE ;I "CV"[$P(^AUPNVSIT(APCPRPS("V"),0),U,3) S APCPRPS("ERROR")="NON APC VISIT TYPE" G VD ;IHS/CMI/LAB
  1. SC I "E"[$P(^AUPNVSIT(APCPRPS("V"),0),U,7) S APCPRPS("ERROR")="EVENT VISIT" G VD ;IHS/CMI/LAB
  1. CHKCL ;
  1.  ;I APCPRPS("CLINIC")="--" G CHKCHA
  1.  ;S X="C"_APCPRPS("CLINIC") I $T(@X)]"" S APCPRPS("ERROR")="NON APC CLINIC CODE" G VD
  1. CHKCHA ;check to see if generated cha but not apc
  1.  ;G:'$D(^AUPNVPRV("AD",APCPRPS("V"))) ERROR
  1.  ;I $P(^APCPLOG(APCPRPS("LOG"),21,APCPRPS("V"),0),U,6) S APCPRPS("ERROR")="CHA RECORD BUT NO APC" G VD
  1.  ;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)
  1. CHKDISC ;
  1.  ;I C=0!(C>1) G ERROR
  1.  ;I '$P($G(^AUTTSITE(1,0)),U,22) D
  1.  ;.S APCPRPS("DPTR")=$P(^DIC(6,APCPRPS("AP"),0),U,4)
  1.  ;.I APCPRPS("DPTR")="" S APCPRPS("ERROR")="NO PROV DISCIPLINE" G VD
  1.  ;.I '$D(^DIC(7,APCPRPS("DPTR"),9999999)) S APCPRPS("ERROR")="NO PROV DISC CODE" G VD
  1.  ;.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
  1.  ;.S APCPRPS("LOCC")=$E($P(^AUTTLOC($P(APCPRPS("VR"),U,6),0),U,10),5,6)
  1.  ;.I (APCPRPS("DISC")=13!(APCPRPS("DISC")=32))&((APCPRPS("LOCC")>49)!(APCPRPS("LOCC")'=+APCPRPS("LOCC"))) S APCPRPS("ERROR")="PHN VISIT NON-CLINIC" G VD
  1.  ;
  1.  ;I $P($G(^AUTTSITE(1,0)),U,22) D
  1.  ;.S APCPRPS("DPTR")=$P($G(^VA(200,APCPRPS("AP"),"PS")),U,5)
  1.  ;.I APCPRPS("DPTR")="" S APCPRPS("ERROR")="NO PROV DISCIPLINE" G VD
  1.  ;.I '$D(^DIC(7,APCPRPS("DPTR"),9999999)) S APCPRPS("ERROR")="NO PROV DISC CODE" G VD
  1.  ;.S APCPRPS("DISC")=$P(^DIC(7,APCPRPS("DPTR"),9999999),U) I APCPRPS("ERROR")="NO PROV DISC CODE" G VD
  1.  ;.S APCPRPS("LOCC")=$E($P(^AUTTLOC($P(APCPRPS("VR"),U,6),0),U,10),5,6)
  1.  ;.I (APCPRPS("DISC")=13!(APCPRPS("DISC")=32))&((APCPRPS("LOCC")>49)!(APCPRPS("LOCC")'=+APCPRPS("LOCC"))) S APCPRPS("ERROR")="PHN VISIT NON-CLINIC" G VD
  1. ERROR I $D(^APCPLOG(APCPRPS("LOG"),51,"AC",APCPRPS("V"))) D  G VD
  1.  .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)
  1.  I $P(^AUPNVSIT(APCPRPS("V"),0),U,3)="C",'$D(^AUPNVPRV("AD",APCPRPS("V"))) S APCPRPS("ERROR")="INCOMPLETE CHS VISIT" G VD
  1.  I $P(^AUPNVSIT(APCPRPS("V"),0),U,3)="C",'$D(^AUPNVPOV("AD",APCPRPS("V"))) S APCPRPS("ERROR")="INCOMPLETE CHS VISIT" G VD
  1.  I $P(^AUPNVSIT(APCPRPS("V"),0),U,7)="I",'$D(^AUPNVPRV("AD",APCPRPS("V"))) S APCPRPS("ERROR")="INCOMPLETE IN HOSPITAL VISIT" G VD
  1.  I $P(^AUPNVSIT(APCPRPS("V"),0),U,7)="I",'$D(^AUPNVPOV("AD",APCPRPS("V"))) S APCPRPS("ERROR")="INCOMPLETE IN HOSPITAL VISIT" G VD
  1. VD ;
  1.  S Y=+APCPRPS("VR") X ^DD("DD") S APCPRPS("RD")=Y
  1. PRN ;
  1.  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")
  1.  Q
  1.  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
  1. HEAD1 ;
  1.  W:$D(IOF) @IOF S APCPRPS("PG")=APCPRPS("PG")+1
  1.  S APCPRPS("LENG")=30+$L(APCPRPS(" PRINT"))
  1.  W !,"Report Run Date: ",$$FMTE^XLFDT(DT),?70,"Page ",APCPRPS("PG")
  1.  W !!?((80-APCPRPS("LENG"))/2),"PCC DATA TRANSMISSION FOR ",APCPRPS(" PRINT")
  1.  W !?24,"Listing of VISITS NOT Exported"
  1.  W !?18,"Date Export Run: ",APCPRPS("RUN DATE")
  1.  W !?8,"Visits Processed for Posting Dates: ",APCPRPS("PRINT BEGIN")," to ",APCPRPS("PRINT END")
  1.  W !!,APCPRPS("80D"),!," HRN ",?10,"VISIT DATE/TIME",?28,"LOCATION",?39,"TYPE",?44,"SC",?45," CLIN",?55,"ERROR MESSAGE",!,APCPRPS("80D"),!
  1.  Q
  1. C42 ;;
  1. C51 ;;
  1. C52 ;;
  1. C53 ;;
  1. C54 ;;
  1. C56 ;;
  1. C60 ;;
  1. C68 ;;