APCLYV51 ; IHS/CMI/LAB - INPATIENT VISITS (CALC) ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
CALC ;find visits by date then store by patient name
S APCLBT=$H
D XTMP^APCLOSUT("APCLYV5","PCC - HOSP DISCH LISTING")
;
S APCLDDT=APCLBD-.0001 G HOSP:APCLSRT="D"
S APCLVDT=APCLDDT
VST S APCLVDT=$O(^AUPNVSIT("B",APCLVDT))
G NEXT:APCLVDT="",NEXT:APCLVDT>(APCLED+.2359) S APCLVDFN=0
VST1 S APCLVDFN=$O(^AUPNVSIT("B",APCLVDT,APCLVDFN)) G VST:APCLVDFN=""
S APCLDDT="A"
G VST1:'$D(^AUPNVINP("AD",APCLVDFN))
G VST1:$$DEMO^APCLUTL($P(^AUPNVSIT(APCLVDFN,0),U,5),$G(APCLDEMO))
S APCLIDFN=$O(^AUPNVINP("AD",APCLVDFN,0)),APCLSTR1=^AUPNVINP(APCLIDFN,0)
S APCLDDT=$P(APCLSTR1,U) D SCREENS G VST1
;
HOSP ;
S APCLDDT=$O(^AUPNVINP("B",APCLDDT))
G NEXT:APCLDDT="",NEXT:APCLDDT>(APCLED+.2359) S APCLIDFN=0
HOSP1 S APCLIDFN=$O(^AUPNVINP("B",APCLDDT,APCLIDFN)) G HOSP:APCLIDFN=""
G HOSP1:'$D(^AUPNVINP(APCLIDFN,0)) S APCLSTR1=^(0)
S APCLVDFN=$P(APCLSTR1,U,3) D SCREENS G HOSP1
;
SCREENS ;SCREEN OUT VISITS NOT ASKED FOR
Q:'$D(^AUPNVSIT(APCLVDFN,0)) S APCLSTR=^(0)
Q:$P(APCLSTR,U,7)'="H"
Q:$P(APCLSTR,"^",11) ;screen out deleted visits
Q:$P(APCLSTR,"^",6)'=APCLLOC ;screen out other facilities
I APCLSRT="A",APCLSV>0,$P(APCLSTR1,U,4)'=APCLSV
I APCLSRT="D",APCLSV>0,$P(APCLSTR1,U,5)'=APCLSV Q
S APCLFLG=$S(APCLICD=1:1,1:0) D POV:APCLICD=2,PRC:APCLICD=3,PROV:APCLICD=4
Q:'APCLFLG
;
S DFN=$P(APCLSTR,U,5)
I $G(APCLLOC)]"",$D(^AUPNPAT(DFN,41,APCLLOC,0)) S APCLNAME=$P(^AUPNPAT(DFN,41,APCLLOC,0),U,2) G L
S APCLNAME=$S($D(^AUPNPAT(DFN,41,DUZ(2),0)):$P(^(0),U,2),1:"NONE")
L S:APCLSRT="D" APCLVDT=$P(APCLSTR,U)
S ^XTMP("APCLYV5",APCLJOB,APCLBTH,"VISITS",APCLNAME,DFN,APCLDDT)=APCLVDFN_"^"_APCLVDT Q
;
NEXT ;
S APCLET=$H
Q
;
;
PROV ;does visit have Provider selection?
S APCLPROV=0
;
PROV1 S APCLPROV=$O(^AUPNVPRV("AD",APCLVDFN,APCLPROV)) Q:APCLPROV=""
G PROV1:'$D(^AUPNVPRV(APCLPROV,0)) S X=$P(^(0),"^")
G PROV1:'$D(^XTMP("APCLYV5",APCLJOB,APCLBTH,"ICD",X))
S APCLFLG=1
Q
POV ;does visit have POV within selected range?
S APCLPV=0
PV1 S APCLPV=$O(^AUPNVPOV("AD",APCLVDFN,APCLPV)) Q:APCLPV=""
G PV1:'$D(^AUPNVPOV(APCLPV,0)) S X=$P(^(0),"^") G PV1:'$D(^ICD9(X,0))
G PV1:'$D(^XTMP("APCLYV5",APCLJOB,APCLBTH,"ICD",X))
S APCLFLG=1
Q
;
PRC ;does visit have procedure(s) within selected range?
S APCLPRC=0
PRC1 S APCLPRC=$O(^AUPNVPRC("AD",APCLVDFN,APCLPRC)) Q:APCLPRC=""
G PRC1:'$D(^AUPNVPRC(APCLPRC,0)) S X=$P(^(0),"^")
G PRC1:'$D(^ICD0(X,0))
I $D(^XTMP("APCLYV5",APCLJOB,APCLBTH,"ICD",X)) S APCLFLG=1 Q
G PRC1
APCLYV51 ; IHS/CMI/LAB - INPATIENT VISITS (CALC) ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
CALC ;find visits by date then store by patient name
+1 SET APCLBT=$HOROLOG
+2 DO XTMP^APCLOSUT("APCLYV5","PCC - HOSP DISCH LISTING")
+3 ;
+4 SET APCLDDT=APCLBD-.0001
IF APCLSRT="D"
GOTO HOSP
+5 SET APCLVDT=APCLDDT
VST SET APCLVDT=$ORDER(^AUPNVSIT("B",APCLVDT))
+1 IF APCLVDT=""
GOTO NEXT
IF APCLVDT>(APCLED+.2359)
GOTO NEXT
SET APCLVDFN=0
VST1 SET APCLVDFN=$ORDER(^AUPNVSIT("B",APCLVDT,APCLVDFN))
IF APCLVDFN=""
GOTO VST
+1 SET APCLDDT="A"
+2 IF '$DATA(^AUPNVINP("AD",APCLVDFN))
GOTO VST1
+3 IF $$DEMO^APCLUTL($PIECE(^AUPNVSIT(APCLVDFN,0),U,5),$GET(APCLDEMO))
GOTO VST1
+4 SET APCLIDFN=$ORDER(^AUPNVINP("AD",APCLVDFN,0))
SET APCLSTR1=^AUPNVINP(APCLIDFN,0)
+5 SET APCLDDT=$PIECE(APCLSTR1,U)
DO SCREENS
GOTO VST1
+6 ;
HOSP ;
+1 SET APCLDDT=$ORDER(^AUPNVINP("B",APCLDDT))
+2 IF APCLDDT=""
GOTO NEXT
IF APCLDDT>(APCLED+.2359)
GOTO NEXT
SET APCLIDFN=0
HOSP1 SET APCLIDFN=$ORDER(^AUPNVINP("B",APCLDDT,APCLIDFN))
IF APCLIDFN=""
GOTO HOSP
+1 IF '$DATA(^AUPNVINP(APCLIDFN,0))
GOTO HOSP1
SET APCLSTR1=^(0)
+2 SET APCLVDFN=$PIECE(APCLSTR1,U,3)
DO SCREENS
GOTO HOSP1
+3 ;
SCREENS ;SCREEN OUT VISITS NOT ASKED FOR
+1 IF '$DATA(^AUPNVSIT(APCLVDFN,0))
QUIT
SET APCLSTR=^(0)
+2 IF $PIECE(APCLSTR,U,7)'="H"
QUIT
+3 ;screen out deleted visits
IF $PIECE(APCLSTR,"^",11)
QUIT
+4 ;screen out other facilities
IF $PIECE(APCLSTR,"^",6)'=APCLLOC
QUIT
+5 IF APCLSRT="A"
IF APCLSV>0
IF $PIECE(APCLSTR1,U,4)'=APCLSV
+6 IF APCLSRT="D"
IF APCLSV>0
IF $PIECE(APCLSTR1,U,5)'=APCLSV
QUIT
+7 SET APCLFLG=$SELECT(APCLICD=1:1,1:0)
IF APCLICD=2
DO POV
IF APCLICD=3
DO PRC
IF APCLICD=4
DO PROV
+8 IF 'APCLFLG
QUIT
+9 ;
+10 SET DFN=$PIECE(APCLSTR,U,5)
+11 IF $GET(APCLLOC)]""
IF $DATA(^AUPNPAT(DFN,41,APCLLOC,0))
SET APCLNAME=$PIECE(^AUPNPAT(DFN,41,APCLLOC,0),U,2)
GOTO L
+12 SET APCLNAME=$SELECT($DATA(^AUPNPAT(DFN,41,DUZ(2),0)):$PIECE(^(0),U,2),1:"NONE")
L IF APCLSRT="D"
SET APCLVDT=$PIECE(APCLSTR,U)
+1 SET ^XTMP("APCLYV5",APCLJOB,APCLBTH,"VISITS",APCLNAME,DFN,APCLDDT)=APCLVDFN_"^"_APCLVDT
QUIT
+2 ;
NEXT ;
+1 SET APCLET=$HOROLOG
+2 QUIT
+3 ;
+4 ;
PROV ;does visit have Provider selection?
+1 SET APCLPROV=0
+2 ;
PROV1 SET APCLPROV=$ORDER(^AUPNVPRV("AD",APCLVDFN,APCLPROV))
IF APCLPROV=""
QUIT
+1 IF '$DATA(^AUPNVPRV(APCLPROV,0))
GOTO PROV1
SET X=$PIECE(^(0),"^")
+2 IF '$DATA(^XTMP("APCLYV5",APCLJOB,APCLBTH,"ICD",X))
GOTO PROV1
+3 SET APCLFLG=1
+4 QUIT
POV ;does visit have POV within selected range?
+1 SET APCLPV=0
PV1 SET APCLPV=$ORDER(^AUPNVPOV("AD",APCLVDFN,APCLPV))
IF APCLPV=""
QUIT
+1 IF '$DATA(^AUPNVPOV(APCLPV,0))
GOTO PV1
SET X=$PIECE(^(0),"^")
IF '$DATA(^ICD9(X,0))
GOTO PV1
+2 IF '$DATA(^XTMP("APCLYV5",APCLJOB,APCLBTH,"ICD",X))
GOTO PV1
+3 SET APCLFLG=1
+4 QUIT
+5 ;
PRC ;does visit have procedure(s) within selected range?
+1 SET APCLPRC=0
PRC1 SET APCLPRC=$ORDER(^AUPNVPRC("AD",APCLVDFN,APCLPRC))
IF APCLPRC=""
QUIT
+1 IF '$DATA(^AUPNVPRC(APCLPRC,0))
GOTO PRC1
SET X=$PIECE(^(0),"^")
+2 IF '$DATA(^ICD0(X,0))
GOTO PRC1
+3 IF $DATA(^XTMP("APCLYV5",APCLJOB,APCLBTH,"ICD",X))
SET APCLFLG=1
QUIT
+4 GOTO PRC1
