- APCLPVC1 ; IHS/CMI/LAB - POV GROUPED BY APC CODES - 6/21/89 11:11 AM ;
- ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
- ;FIND PCC AMBULATORY VISITS FOR DATE RANGE, RECODE TO APC CODES, AND TOTAL
- ;
- ;cmi/anch/maw 9/10/2007 code set versioning in I1
- ;
- S APCLBT=$H,APCLJOB=$J
- D XTMP^APCLOSUT("APCLPVC","PCC - VISITS BY APC RECODE")
- S APCLS=APCLSD-.0001
- F I=0:0 S APCLS=$O(^AUPNVSIT("B",APCLS)) Q:APCLS=""!(APCLS>(APCLFD+.2359)) D C1
- Q
- C1 S APCLVDFN=0 F J=0:0 S APCLVDFN=$O(^AUPNVSIT("B",APCLS,APCLVDFN)) Q:APCLVDFN="" D C2
- S APCLET=$H
- Q
- C2 Q:'$D(^AUPNVSIT(APCLVDFN,0))
- S APCLVN0=^AUPNVSIT(APCLVDFN,0)
- Q:$$DEMO^APCLUTL($P(APCLVN0,U,5),$G(APCLDEMO))
- Q:$P(APCLVN0,"^",7)'="A"
- Q:'$P(APCLVN0,U,9)
- Q:"C"[$P(APCLVN0,"^",3)
- Q:$P(APCLVN0,"^",11)
- G:'$D(APCLCOM) ICDCK
- S APCLPDFN=$P(APCLVN0,"^",5) S APCLPCOM=$S($D(^AUPNPAT(APCLPDFN,11)):$P(^(11),"^",18),1:"NOCOM")
- Q:APCLPCOM="NOCOM"
- Q:APCLPCOM'=APCLCOM
- ICDCK S APCLIDFN="" F S APCLIDFN=$O(^AUPNVPOV("AD",APCLVDFN,APCLIDFN)) Q:APCLIDFN="" D I1
- Q
- I1 Q:'$D(^AUPNVPOV(APCLIDFN,0))
- S APCLINO=+^AUPNVPOV(APCLIDFN,0)
- ;S APCLX=$P(^ICD9(APCLINO,0),"^") D ^APCLRAPC G:'$D(APCLY) I11 G:APCLY="" I11 S APCLAPC=APCLY ;cmi/anch/maw 9/10/2007 orig line
- S APCLX=$P($$ICDDX^ICDEX(APCLINO),"^",2) D ^APCLRAPC G:'$D(APCLY) I11 G:APCLY="" I11 S APCLAPC=APCLY ;cmi/anch/maw 9/10/2007 csv
- S ^(0)=$S($D(^XTMP("APCLPVC",APCLJOB,APCLBT,APCLAPC,0)):^(0)+1,1:1)
- Q:'APCLLIM S ^(APCLINO)=$S($D(^XTMP("APCLPVC",APCLJOB,APCLBT,APCLAPC,APCLINO)):^(APCLINO)+1,1:1) G I12
- I11 S ^("NOCODE")=$S($D(^XTMP("APCLPVC",APCLJOB,APCLBT,"NOCODE")):^("NOCODE"),1:1)
- I12 Q
- APCLPVC1 ; IHS/CMI/LAB - POV GROUPED BY APC CODES - 6/21/89 11:11 AM ;
- +1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
- +2 ;FIND PCC AMBULATORY VISITS FOR DATE RANGE, RECODE TO APC CODES, AND TOTAL
- +3 ;
- +4 ;cmi/anch/maw 9/10/2007 code set versioning in I1
- +5 ;
- +6 SET APCLBT=$HOROLOG
- SET APCLJOB=$JOB
- +7 DO XTMP^APCLOSUT("APCLPVC","PCC - VISITS BY APC RECODE")
- +8 SET APCLS=APCLSD-.0001
- +9 FOR I=0:0
- SET APCLS=$ORDER(^AUPNVSIT("B",APCLS))
- IF APCLS=""!(APCLS>(APCLFD+.2359))
- QUIT
- DO C1
- +10 QUIT
- C1 SET APCLVDFN=0
- FOR J=0:0
- SET APCLVDFN=$ORDER(^AUPNVSIT("B",APCLS,APCLVDFN))
- IF APCLVDFN=""
- QUIT
- DO C2
- +1 SET APCLET=$HOROLOG
- +2 QUIT
- C2 IF '$DATA(^AUPNVSIT(APCLVDFN,0))
- QUIT
- +1 SET APCLVN0=^AUPNVSIT(APCLVDFN,0)
- +2 IF $$DEMO^APCLUTL($PIECE(APCLVN0,U,5),$GET(APCLDEMO))
- QUIT
- +3 IF $PIECE(APCLVN0,"^",7)'="A"
- QUIT
- +4 IF '$PIECE(APCLVN0,U,9)
- QUIT
- +5 IF "C"[$PIECE(APCLVN0,"^",3)
- QUIT
- +6 IF $PIECE(APCLVN0,"^",11)
- QUIT
- +7 IF '$DATA(APCLCOM)
- GOTO ICDCK
- +8 SET APCLPDFN=$PIECE(APCLVN0,"^",5)
- SET APCLPCOM=$SELECT($DATA(^AUPNPAT(APCLPDFN,11)):$PIECE(^(11),"^",18),1:"NOCOM")
- +9 IF APCLPCOM="NOCOM"
- QUIT
- +10 IF APCLPCOM'=APCLCOM
- QUIT
- ICDCK SET APCLIDFN=""
- FOR
- SET APCLIDFN=$ORDER(^AUPNVPOV("AD",APCLVDFN,APCLIDFN))
- IF APCLIDFN=""
- QUIT
- DO I1
- +1 QUIT
- I1 IF '$DATA(^AUPNVPOV(APCLIDFN,0))
- QUIT
- +1 SET APCLINO=+^AUPNVPOV(APCLIDFN,0)
- +2 ;S APCLX=$P(^ICD9(APCLINO,0),"^") D ^APCLRAPC G:'$D(APCLY) I11 G:APCLY="" I11 S APCLAPC=APCLY ;cmi/anch/maw 9/10/2007 orig line
- +3 ;cmi/anch/maw 9/10/2007 csv
- SET APCLX=$PIECE($$ICDDX^ICDEX(APCLINO),"^",2)
- DO ^APCLRAPC
- IF '$DATA(APCLY)
- GOTO I11
- IF APCLY=""
- GOTO I11
- SET APCLAPC=APCLY
- +4 SET ^(0)=$SELECT($DATA(^XTMP("APCLPVC",APCLJOB,APCLBT,APCLAPC,0)):^(0)+1,1:1)
- +5 IF 'APCLLIM
- QUIT
- SET ^(APCLINO)=$SELECT($DATA(^XTMP("APCLPVC",APCLJOB,APCLBT,APCLAPC,APCLINO)):^(APCLINO)+1,1:1)
- GOTO I12
- I11 SET ^("NOCODE")=$SELECT($DATA(^XTMP("APCLPVC",APCLJOB,APCLBT,"NOCODE")):^("NOCODE"),1:1)
- I12 QUIT
