- APCL1H1 ; IHS/CMI/LAB - Inpatient 2A report process ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- S APCLBT=$H,APCLJOB=$J
- K ^XTMP("APCL1H",APCLJOB,APCLBT)
- D XTMP^APCLOSUT("APCL1H","PCC HOSPITALIZATION COUNT RPT APCL1H")
- S APCLSD=APCLFY-.0001 S X1=APCLFY,X2=365 D C^%DTC S APCLFYE=$E(X,1,3)_"0930"
- LOC S APCLJ=0 F S APCLJ=$O(^AUTTLOC(APCLJ)) Q:APCLJ'=+APCLJ S:$P(^AUTTLOC(APCLJ,0),U,4)=APCLAREA ^XTMP("APCL1H",APCLJOB,APCLBT,"LOCATIONS",APCLJ)=""
- V ; Run by visit date
- S APCLGRAN=0
- S APCLODAT=APCLSD F S APCLODAT=$O(^AUPNVINP("B",APCLODAT)) Q:APCLODAT=""!((APCLODAT\1)>APCLFYE) D V1
- S APCLET=$H
- Q
- V1 ;
- S APCLVINP="" F S APCLVINP=$O(^AUPNVINP("B",APCLODAT,APCLVINP)) Q:APCLVINP'=+APCLVINP I $D(^AUPNVINP(APCLVINP,0)) S APCLHREC=^(0) D PROC,EOJ
- Q
- PROC ;
- Q:$$DEMO^APCLUTL($P(APCLHREC,U,2),$G(APCLDEMO))
- S APCLVDFN=$P(APCLHREC,U,3)
- S APCLVREC=^AUPNVSIT(APCLVDFN,0)
- Q:$D(^APCLCNTL(4,11,"B",$P(APCLVREC,U,3))) ;LAB/TUCSON CHANGED FOR VA
- S APCLVLOC=$P(APCLVREC,U,6)
- Q:'$D(^XTMP("APCL1H",APCLJOB,APCLBT,"LOCATIONS",APCLVLOC))
- Q:'$D(^AUPNVPOV("AD",APCLVDFN))
- Q:'$D(^AUPNVPRV("AD",APCLVDFN))
- PROC1 S (APCL1,APCL2)=0 F S APCL2=$O(^AUPNVPRV("AD",APCLVDFN,APCL2)) Q:APCL2="" I $P(^AUPNVPRV(APCL2,0),U,4)="P" S APCL1=APCL1+1
- Q:APCL1=0
- Q:APCL1>1
- S APCLMOS=+$E(APCLODAT,4,5)
- S ^(APCLMOS)=$S($D(^XTMP("APCL1H",APCLJOB,APCLBT,"MONLOCTOT",APCLVLOC,APCLMOS)):^(APCLMOS)+1,1:1)
- S ^(APCLVLOC)=$S($D(^XTMP("APCL1H",APCLJOB,APCLBT,"LOCTOT",APCLVLOC)):^(APCLVLOC)+1,1:1)
- S APCLGRAN=APCLGRAN+1
- Q
- EOJ K APCLVLOC,APCLHREC,APCL1,APCL2,APCLVREC,APCLVDFN
- Q
- ;
- APCL1H1 ; IHS/CMI/LAB - Inpatient 2A report process ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 SET APCLBT=$HOROLOG
- SET APCLJOB=$JOB
- +3 KILL ^XTMP("APCL1H",APCLJOB,APCLBT)
- +4 DO XTMP^APCLOSUT("APCL1H","PCC HOSPITALIZATION COUNT RPT APCL1H")
- +5 SET APCLSD=APCLFY-.0001
- SET X1=APCLFY
- SET X2=365
- DO C^%DTC
- SET APCLFYE=$EXTRACT(X,1,3)_"0930"
- LOC SET APCLJ=0
- FOR
- SET APCLJ=$ORDER(^AUTTLOC(APCLJ))
- IF APCLJ'=+APCLJ
- QUIT
- IF $PIECE(^AUTTLOC(APCLJ,0),U,4)=APCLAREA
- SET ^XTMP("APCL1H",APCLJOB,APCLBT,"LOCATIONS",APCLJ)=""
- V ; Run by visit date
- +1 SET APCLGRAN=0
- +2 SET APCLODAT=APCLSD
- FOR
- SET APCLODAT=$ORDER(^AUPNVINP("B",APCLODAT))
- IF APCLODAT=""!((APCLODAT\1)>APCLFYE)
- QUIT
- DO V1
- +3 SET APCLET=$HOROLOG
- +4 QUIT
- V1 ;
- +1 SET APCLVINP=""
- FOR
- SET APCLVINP=$ORDER(^AUPNVINP("B",APCLODAT,APCLVINP))
- IF APCLVINP'=+APCLVINP
- QUIT
- IF $DATA(^AUPNVINP(APCLVINP,0))
- SET APCLHREC=^(0)
- DO PROC
- DO EOJ
- +2 QUIT
- PROC ;
- +1 IF $$DEMO^APCLUTL($PIECE(APCLHREC,U,2),$GET(APCLDEMO))
- QUIT
- +2 SET APCLVDFN=$PIECE(APCLHREC,U,3)
- +3 SET APCLVREC=^AUPNVSIT(APCLVDFN,0)
- +4 ;LAB/TUCSON CHANGED FOR VA
- IF $DATA(^APCLCNTL(4,11,"B",$PIECE(APCLVREC,U,3)))
- QUIT
- +5 SET APCLVLOC=$PIECE(APCLVREC,U,6)
- +6 IF '$DATA(^XTMP("APCL1H",APCLJOB,APCLBT,"LOCATIONS",APCLVLOC))
- QUIT
- +7 IF '$DATA(^AUPNVPOV("AD",APCLVDFN))
- QUIT
- +8 IF '$DATA(^AUPNVPRV("AD",APCLVDFN))
- QUIT
- PROC1 SET (APCL1,APCL2)=0
- FOR
- SET APCL2=$ORDER(^AUPNVPRV("AD",APCLVDFN,APCL2))
- IF APCL2=""
- QUIT
- IF $PIECE(^AUPNVPRV(APCL2,0),U,4)="P"
- SET APCL1=APCL1+1
- +1 IF APCL1=0
- QUIT
- +2 IF APCL1>1
- QUIT
- +3 SET APCLMOS=+$EXTRACT(APCLODAT,4,5)
- +4 SET ^(APCLMOS)=$SELECT($DATA(^XTMP("APCL1H",APCLJOB,APCLBT,"MONLOCTOT",APCLVLOC,APCLMOS)):^(APCLMOS)+1,1:1)
- +5 SET ^(APCLVLOC)=$SELECT($DATA(^XTMP("APCL1H",APCLJOB,APCLBT,"LOCTOT",APCLVLOC)):^(APCLVLOC)+1,1:1)
- +6 SET APCLGRAN=APCLGRAN+1
- +7 QUIT
- EOJ KILL APCLVLOC,APCLHREC,APCL1,APCL2,APCLVREC,APCLVDFN
- +1 QUIT
- +2 ;
