- APCLER11 ; IHS/CMI/LAB - APC REPORT PROCESS ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;IHS/CMI/LAB - patch 5 fixed to only use 72 hours
- ;
- START ;
- S APCLBT=$H
- K ^XTMP("APCLER1",APCLJOB,APCLBTH)
- D XTMP^APCLOSUT("APCLER1","PCC - ER 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
- Q:$$DEMO^APCLUTL($P(APCLVREC,U,5),$G(APCLDEMO))
- Q:$P(APCLVREC,U,8)=""
- I $G(APCLCLN),APCLCLN'=$P(APCLVREC,U,8) Q
- I APCLLOC]"",APCLLOC'=$P(APCLVREC,U,6) Q
- I APCLPROV,$$PRIMPROV^APCLV(APCLVDFN,"I")'=APCLPROV Q
- ;
- ; ==> 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
- ..Q:$P(^AUPNVSIT(APCLV,0),U,8)'=APCLERCL
- ..Q:APCLV=APCLVDFN ;quit if same visit
- ..;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("APCLER1",APCLJOB,APCLBTH,$P(APCLVREC,U,5),APCLVDFN,APCLV)=""
- Q
- EOJ ;
- K APCLVREC,APCLVDFN,APCLV,APCLODAT
- Q
- ;
- APCLER11 ; IHS/CMI/LAB - APC REPORT PROCESS ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;IHS/CMI/LAB - patch 5 fixed to only use 72 hours
- +3 ;
- START ;
- +1 SET APCLBT=$HOROLOG
- +2 KILL ^XTMP("APCLER1",APCLJOB,APCLBTH)
- +3 DO XTMP^APCLOSUT("APCLER1","PCC - ER 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 $$DEMO^APCLUTL($PIECE(APCLVREC,U,5),$GET(APCLDEMO))
- QUIT
- +3 IF $PIECE(APCLVREC,U,8)=""
- QUIT
- +4 IF $GET(APCLCLN)
- IF APCLCLN'=$PIECE(APCLVREC,U,8)
- QUIT
- +5 IF APCLLOC]""
- IF APCLLOC'=$PIECE(APCLVREC,U,6)
- QUIT
- +6 IF APCLPROV
- IF $$PRIMPROV^APCLV(APCLVDFN,"I")'=APCLPROV
- QUIT
- +7 ;
- +8 ; ==> go through all of this patients visits from visit date
- +9 ; ==> to 3 days after visit date
- +10 ; ==> APCLIVD=inverse date of vd
- +11 ; ==> APCLFVD=inverse date of 3 days from then
- +12 ;
- +13 ; => add 3 days to current visit date
- +14 SET X1=$PIECE($PIECE(APCLVREC,U),".")
- SET X2=3
- DO C^%DTC
- SET APCL3D=X
- +15 ; => calculate starting point for $O
- +16 SET APCLFVD=((9999999-APCL3D)-1)_".9999"
- +17 SET APCLIVD=9999999-$PIECE($PIECE(APCLVREC,U),".")
- +18 FOR
- SET APCLFVD=$ORDER(^AUPNVSIT("AA",$PIECE(APCLVREC,U,5),APCLFVD))
- IF APCLFVD=""!($PIECE(APCLFVD,".")>APCLIVD)
- QUIT
- Begin DoDot:1
- +19 SET APCLV=0
- FOR
- SET APCLV=$ORDER(^AUPNVSIT("AA",$PIECE(APCLVREC,U,5),APCLFVD,APCLV))
- IF APCLV'=+APCLV
- QUIT
- Begin DoDot:2
- +20 IF $PIECE(^AUPNVSIT(APCLV,0),U,8)'=APCLERCL
- QUIT
- +21 ;quit if same visit
- IF APCLV=APCLVDFN
- QUIT
- +22 ;S Y=$P(APCLVREC,U) D DD^%DT S APCLT1=$P(Y,"@",2),APCLT1=$TR(APCLT1,":","") ;IHS/CMI/LAB
- +23 ;S Y=$P(^AUPNVSIT(APCLV,0),U) D DD^%DT S APCLT2=$P(Y,"@",2),APCLT2=$TR(APCLT2,":","") ;IHS/CMI/LAB
- +24 SET Y=$$FMDIFF^XLFDT($PIECE(^AUPNVSIT(APCLV,0),U),$PIECE(APCLVREC,U),2)
- +25 IF APCLHR=7
- IF Y>259200
- QUIT
- +26 IF APCLHR=4
- IF Y>172800
- QUIT
- +27 ;I $P($P(^AUPNVSIT(APCLV,0),U),".")=$P($P(APCLVREC,U),"."),APCLT1>APCLT2 Q
- +28 SET ^XTMP("APCLER1",APCLJOB,APCLBTH,$PIECE(APCLVREC,U,5),APCLVDFN,APCLV)=""
- End DoDot:2
- End DoDot:1
- +29 QUIT
- EOJ ;
- +1 KILL APCLVREC,APCLVDFN,APCLV,APCLODAT
- +2 QUIT
- +3 ;
