APCLRT11 ; IHS/CMI/LAB - APC REPORT PROCESS ;
;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009
;IHS/CMI/LAB - patch 5 fixed to only use 72 hours
;
START ;
S APCLBT=$H
K ^XTMP("APCLRT1",APCLJOB,APCLBTH)
D XTMP^APCLOSUT("APCLRT1","PCC - RETURNS RPT 1")
;
V ; Run by visit date
S APCLODAT=APCLSD_".9999" F S APCLODAT=$O(^AUPNVSIT("B",APCLODAT)) Q:APCLODAT=""!((APCLODAT\1)>APCLED) D V1
;
END ;
S APCLET=$H
D EOJ
Q
V1 ;
;count only visits with a clinic = the value in APCLCLN
S APCLVDFN="" F S APCLVDFN=$O(^AUPNVSIT("B",APCLODAT,APCLVDFN)) Q:APCLVDFN'=+APCLVDFN I $D(^AUPNVSIT(APCLVDFN,0)),$P(^(0),U,9),'$P(^(0),U,11) S APCLVREC=^(0) D PROC
Q
PROC ;
K APCLSKIP
I APCLEINC=1 Q:'$D(^AUPNVPOV("AD",APCLVDFN)) Q:'$D(^AUPNVPRV("AD",APCLVDFN))
Q:$$DEMO^APCLUTL($P(APCLVREC,U,5),$G(APCLDEMO))
Q:$P(APCLVREC,U,8)=""
I $G(APCLFCLN),APCLFCLN'=$P(APCLVREC,U,8) Q
I $D(APCLLOC) S X=$P(APCLVREC,U,6) Q:X="" Q:'$D(APCLLOC(X))
;I APCLLOC]"",APCLLOC'=$P(APCLVREC,U,6) Q
I APCLPROV,$$PRIMPROV^APCLV(APCLVDFN,"I")'=APCLPROV Q
;Q:'$D(^AUPNVPOV("AD",APCLVDFN)) ;NOT YET CODED
;
; ==> go through all of this patients visits from visit date
; ==> to 3 days after visit date
; ==> APCLIVD=inverse date of vd
; ==> APCLFVD=inverse date of 3 days from then
;
; => add 3 days to current visit date
S X1=$P($P(APCLVREC,U),"."),X2=3 D C^%DTC S APCL3D=X
; => calculate starting point for $O
S APCLFVD=((9999999-APCL3D)-1)_".9999"
S APCLIVD=9999999-$P($P(APCLVREC,U),".")
F S APCLFVD=$O(^AUPNVSIT("AA",$P(APCLVREC,U,5),APCLFVD)) Q:APCLFVD=""!($P(APCLFVD,".")>APCLIVD) D
.S APCLV=0 F S APCLV=$O(^AUPNVSIT("AA",$P(APCLVREC,U,5),APCLFVD,APCLV)) Q:APCLV'=+APCLV D
..I APCLTCLN,$P(^AUPNVSIT(APCLV,0),U,8)'=APCLTCLN Q
..Q:APCLV=APCLVDFN ;quit if same visit
..I APCLSDX Q:$$PRIMPOV^APCLV(APCLVDFN,"C")'=$$PRIMPOV^APCLV(APCLV,"C")
..I APCLEINC Q:'$D(^AUPNVPOV("AD",APCLV)) Q:'$D(^AUPNVPRV("AD",APCLV))
..;Q:'$D(^AUPNVPOV("AD",APCLV)) ;no pov
..;S Y=$P(APCLVREC,U) D DD^%DT S APCLT1=$P(Y,"@",2),APCLT1=$TR(APCLT1,":","") ;IHS/CMI/LAB
..;S Y=$P(^AUPNVSIT(APCLV,0),U) D DD^%DT S APCLT2=$P(Y,"@",2),APCLT2=$TR(APCLT2,":","") ;IHS/CMI/LAB
..S Y=$$FMDIFF^XLFDT($P(^AUPNVSIT(APCLV,0),U),$P(APCLVREC,U),2)
..I APCLHR=7 Q:Y>259200
..;I APCLHR=4 Q:Y>172800
..;I $P($P(^AUPNVSIT(APCLV,0),U),".")=$P($P(APCLVREC,U),"."),APCLT1>APCLT2 Q
..S ^XTMP("APCLRT1",APCLJOB,APCLBTH,$P(APCLVREC,U,5),APCLVDFN,APCLV)=""
Q
EOJ ;
K APCLVREC,APCLVDFN,APCLV,APCLODAT
Q
;
APCLRT11 ; IHS/CMI/LAB - APC REPORT PROCESS ;
+1 ;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009
+2 ;IHS/CMI/LAB - patch 5 fixed to only use 72 hours
+3 ;
START ;
+1 SET APCLBT=$HOROLOG
+2 KILL ^XTMP("APCLRT1",APCLJOB,APCLBTH)
+3 DO XTMP^APCLOSUT("APCLRT1","PCC - RETURNS RPT 1")
+4 ;
V ; Run by visit date
+1 SET APCLODAT=APCLSD_".9999"
FOR
SET APCLODAT=$ORDER(^AUPNVSIT("B",APCLODAT))
IF APCLODAT=""!((APCLODAT\1)>APCLED)
QUIT
DO V1
+2 ;
END ;
+1 SET APCLET=$HOROLOG
+2 DO EOJ
+3 QUIT
V1 ;
+1 ;count only visits with a clinic = the value in APCLCLN
+2 SET APCLVDFN=""
FOR
SET APCLVDFN=$ORDER(^AUPNVSIT("B",APCLODAT,APCLVDFN))
IF APCLVDFN'=+APCLVDFN
QUIT
IF $DATA(^AUPNVSIT(APCLVDFN,0))
IF $PIECE(^(0),U,9)
IF '$PIECE(^(0),U,11)
SET APCLVREC=^(0)
DO PROC
+3 QUIT
PROC ;
+1 KILL APCLSKIP
+2 IF APCLEINC=1
IF '$DATA(^AUPNVPOV("AD",APCLVDFN))
QUIT
IF '$DATA(^AUPNVPRV("AD",APCLVDFN))
QUIT
+3 IF $$DEMO^APCLUTL($PIECE(APCLVREC,U,5),$GET(APCLDEMO))
QUIT
+4 IF $PIECE(APCLVREC,U,8)=""
QUIT
+5 IF $GET(APCLFCLN)
IF APCLFCLN'=$PIECE(APCLVREC,U,8)
QUIT
+6 IF $DATA(APCLLOC)
SET X=$PIECE(APCLVREC,U,6)
IF X=""
QUIT
IF '$DATA(APCLLOC(X))
QUIT
+7 ;I APCLLOC]"",APCLLOC'=$P(APCLVREC,U,6) Q
+8 IF APCLPROV
IF $$PRIMPROV^APCLV(APCLVDFN,"I")'=APCLPROV
QUIT
+9 ;Q:'$D(^AUPNVPOV("AD",APCLVDFN)) ;NOT YET CODED
+10 ;
+11 ; ==> go through all of this patients visits from visit date
+12 ; ==> to 3 days after visit date
+13 ; ==> APCLIVD=inverse date of vd
+14 ; ==> APCLFVD=inverse date of 3 days from then
+15 ;
+16 ; => add 3 days to current visit date
+17 SET X1=$PIECE($PIECE(APCLVREC,U),".")
SET X2=3
DO C^%DTC
SET APCL3D=X
+18 ; => calculate starting point for $O
+19 SET APCLFVD=((9999999-APCL3D)-1)_".9999"
+20 SET APCLIVD=9999999-$PIECE($PIECE(APCLVREC,U),".")
+21 FOR
SET APCLFVD=$ORDER(^AUPNVSIT("AA",$PIECE(APCLVREC,U,5),APCLFVD))
IF APCLFVD=""!($PIECE(APCLFVD,".")>APCLIVD)
QUIT
Begin DoDot:1
+22 SET APCLV=0
FOR
SET APCLV=$ORDER(^AUPNVSIT("AA",$PIECE(APCLVREC,U,5),APCLFVD,APCLV))
IF APCLV'=+APCLV
QUIT
Begin DoDot:2
+23 IF APCLTCLN
IF $PIECE(^AUPNVSIT(APCLV,0),U,8)'=APCLTCLN
QUIT
+24 ;quit if same visit
IF APCLV=APCLVDFN
QUIT
+25 IF APCLSDX
IF $$PRIMPOV^APCLV(APCLVDFN,"C")'=$$PRIMPOV^APCLV(APCLV,"C")
QUIT
+26 IF APCLEINC
IF '$DATA(^AUPNVPOV("AD",APCLV))
QUIT
IF '$DATA(^AUPNVPRV("AD",APCLV))
QUIT
+27 ;Q:'$D(^AUPNVPOV("AD",APCLV)) ;no pov
+28 ;S Y=$P(APCLVREC,U) D DD^%DT S APCLT1=$P(Y,"@",2),APCLT1=$TR(APCLT1,":","") ;IHS/CMI/LAB
+29 ;S Y=$P(^AUPNVSIT(APCLV,0),U) D DD^%DT S APCLT2=$P(Y,"@",2),APCLT2=$TR(APCLT2,":","") ;IHS/CMI/LAB
+30 SET Y=$$FMDIFF^XLFDT($PIECE(^AUPNVSIT(APCLV,0),U),$PIECE(APCLVREC,U),2)
+31 IF APCLHR=7
IF Y>259200
QUIT
+32 ;I APCLHR=4 Q:Y>172800
+33 ;I $P($P(^AUPNVSIT(APCLV,0),U),".")=$P($P(APCLVREC,U),"."),APCLT1>APCLT2 Q
+34 SET ^XTMP("APCLRT1",APCLJOB,APCLBTH,$PIECE(APCLVREC,U,5),APCLVDFN,APCLV)=""
End DoDot:2
End DoDot:1
+35 QUIT
EOJ ;
+1 KILL APCLVREC,APCLVDFN,APCLV,APCLODAT
+2 QUIT
+3 ;
