- 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
