APCDFC1 ; IHS/CMI/LAB - FORMS COUNT (FILE) report process ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
P ; Run by posting date
S APCDODAT=APCDSD_".9999" F S APCDODAT=$O(^APCDFORM("B",APCDODAT)) Q:APCDODAT=""!((APCDODAT\1)>APCDED) S APCDDFN=$O(^APCDFORM("B",APCDODAT,"")) D V1
Q
V1 ;
S APCDC=0 F S APCDC=$O(^APCDFORM(APCDDFN,11,APCDC)) Q:APCDC'=+APCDC S APCDVDFN=$P(^APCDFORM(APCDDFN,11,APCDC,0),U) I APCDVDFN]"",$D(^AUPNVSIT(APCDVDFN,0)) D PROC
Q
PROC ;
I APCDDEC'="ALL",APCDDEC'=$P(^APCDFORM(APCDDFN,11,APCDC,0),U,2) Q
Q:$P(^APCDFORM(APCDDFN,11,APCDC,0),U,2)=""
Q:'$D(^VA(200,$P(^APCDFORM(APCDDFN,11,APCDC,0),U,2),0))
S APCDAP=$P(^VA(200,$P(^APCDFORM(APCDDFN,11,APCDC,0),U,2),0),U)
S APCDVREC=^AUPNVSIT(APCDVDFN,0)
S APCDVDAT=$P($P(APCDVREC,U),".")
Q:'$P(APCDVREC,U,9)
Q:$P(APCDVREC,U,11)
Q:'$D(^AUPNVPOV("AD",APCDVDFN))
Q:'$D(^AUPNVPRV("AD",APCDVDFN))
D @APCDPROC
D DATE
SET S ^(APCDDATE)=$S($D(^XTMP("APCDFC",$J,APCDAP,APCDSORT,APCDDATE)):^(APCDDATE)+1,1:1)
S ^(APCDDATE)=$S($D(^XTMP("APCDFC",$J,APCDAP,APCDSORT,"DEP COUNT",APCDDATE)):^(APCDDATE)+APCDVDES,1:APCDVDES)
Q:'APCDSUBV
S ^(APCDVDAT)=$S($D(^XTMP("APCDFC",$J,APCDAP,APCDSORT,"VISIT DATE",APCDDATE,APCDVDAT)):^(APCDVDAT)+1,1:1)
Q
EOJ ; clean up and exit
K APCDVREC,APCDCLIN,APCDSKIP,APCD1,APCD2,APCDAP,APCDX,APCDY,APCDVDES,APCDDATE,APCDPROV,APCDSEC,APCDZ
Q
;
1 ;
S APCDCLIN=$P(APCDVREC,U,8) I APCDCLIN="" S APCDSORT="NO CLINIC ENTERED" Q
S APCDSORT=$P(^DIC(40.7,APCDCLIN,0),U)
Q
;
2 ;
K ^UTILITY("DIQ1",$J)
K DIQ,DIC,DA,DR
S DIC="^AUPNVSIT(",DR=".07",DA=APCDVDFN,DIQ(0)="E" D EN^DIQ1 K DIC,DA,DR,DIQ
S APCDSORT=^UTILITY("DIQ1",$J,9000010,APCDVDFN,.07,"E")
K ^UTILITY("DIQ1",$J)
Q
;
4 ;
S APCDSORT="NONE"
Q
3 ;TYPE
K ^UTILITY("DIQ1",$J)
K DIQ,DIC,DA,DR
S DIC="^AUPNVSIT(",DR=".03",DA=APCDVDFN,DIQ(0)="E" D EN^DIQ1 K DIC,DA,DR,DIQ
S APCDSORT=^UTILITY("DIQ1",$J,9000010,APCDVDFN,.03,"E")
K ^UTILITY("DIQ1",$J)
Q
;
DATE ;
S APCDDATE=$P(APCDODAT,".")
CALDEC ;
S APCDVDES=0
S APCDVFLE=9000010 F APCDFL=0:0 S APCDVFLE=$O(^DIC(APCDVFLE)) Q:APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE) D
.Q:APCDVFLE=9000010.09
.Q:APCDVFLE=9000010.14
.Q:APCDVFLE=9000010.22
.Q:APCDVFLE=9000010.24
.Q:APCDVFLE=9000010.25
.Q:APCDVFLE=9000010.31
.Q:APCDVFLE=9000010.99
.S APCDVDG=^DIC(APCDVFLE,0,"GL"),APCDVIGR=APCDVDG_"""AD"",APCDVDFN,APCDEDFN)"
.S APCDEDFN="" F APCDEL=1:1 S APCDEDFN=$O(@APCDVIGR) Q:APCDEDFN'=+APCDEDFN S APCDVDES=APCDVDES+1
.Q
Q
;
APCDFC1 ; IHS/CMI/LAB - FORMS COUNT (FILE) report process ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
P ; Run by posting date
+1 SET APCDODAT=APCDSD_".9999"
FOR
SET APCDODAT=$ORDER(^APCDFORM("B",APCDODAT))
IF APCDODAT=""!((APCDODAT\1)>APCDED)
QUIT
SET APCDDFN=$ORDER(^APCDFORM("B",APCDODAT,""))
DO V1
+2 QUIT
V1 ;
+1 SET APCDC=0
FOR
SET APCDC=$ORDER(^APCDFORM(APCDDFN,11,APCDC))
IF APCDC'=+APCDC
QUIT
SET APCDVDFN=$PIECE(^APCDFORM(APCDDFN,11,APCDC,0),U)
IF APCDVDFN]""
IF $DATA(^AUPNVSIT(APCDVDFN,0))
DO PROC
+2 QUIT
PROC ;
+1 IF APCDDEC'="ALL"
IF APCDDEC'=$PIECE(^APCDFORM(APCDDFN,11,APCDC,0),U,2)
QUIT
+2 IF $PIECE(^APCDFORM(APCDDFN,11,APCDC,0),U,2)=""
QUIT
+3 IF '$DATA(^VA(200,$PIECE(^APCDFORM(APCDDFN,11,APCDC,0),U,2),0))
QUIT
+4 SET APCDAP=$PIECE(^VA(200,$PIECE(^APCDFORM(APCDDFN,11,APCDC,0),U,2),0),U)
+5 SET APCDVREC=^AUPNVSIT(APCDVDFN,0)
+6 SET APCDVDAT=$PIECE($PIECE(APCDVREC,U),".")
+7 IF '$PIECE(APCDVREC,U,9)
QUIT
+8 IF $PIECE(APCDVREC,U,11)
QUIT
+9 IF '$DATA(^AUPNVPOV("AD",APCDVDFN))
QUIT
+10 IF '$DATA(^AUPNVPRV("AD",APCDVDFN))
QUIT
+11 DO @APCDPROC
+12 DO DATE
SET SET ^(APCDDATE)=$SELECT($DATA(^XTMP("APCDFC",$JOB,APCDAP,APCDSORT,APCDDATE)):^(APCDDATE)+1,1:1)
+1 SET ^(APCDDATE)=$SELECT($DATA(^XTMP("APCDFC",$JOB,APCDAP,APCDSORT,"DEP COUNT",APCDDATE)):^(APCDDATE)+APCDVDES,1:APCDVDES)
+2 IF 'APCDSUBV
QUIT
+3 SET ^(APCDVDAT)=$SELECT($DATA(^XTMP("APCDFC",$JOB,APCDAP,APCDSORT,"VISIT DATE",APCDDATE,APCDVDAT)):^(APCDVDAT)+1,1:1)
+4 QUIT
EOJ ; clean up and exit
+1 KILL APCDVREC,APCDCLIN,APCDSKIP,APCD1,APCD2,APCDAP,APCDX,APCDY,APCDVDES,APCDDATE,APCDPROV,APCDSEC,APCDZ
+2 QUIT
+3 ;
1 ;
+1 SET APCDCLIN=$PIECE(APCDVREC,U,8)
IF APCDCLIN=""
SET APCDSORT="NO CLINIC ENTERED"
QUIT
+2 SET APCDSORT=$PIECE(^DIC(40.7,APCDCLIN,0),U)
+3 QUIT
+4 ;
2 ;
+1 KILL ^UTILITY("DIQ1",$JOB)
+2 KILL DIQ,DIC,DA,DR
+3 SET DIC="^AUPNVSIT("
SET DR=".07"
SET DA=APCDVDFN
SET DIQ(0)="E"
DO EN^DIQ1
KILL DIC,DA,DR,DIQ
+4 SET APCDSORT=^UTILITY("DIQ1",$JOB,9000010,APCDVDFN,.07,"E")
+5 KILL ^UTILITY("DIQ1",$JOB)
+6 QUIT
+7 ;
4 ;
+1 SET APCDSORT="NONE"
+2 QUIT
3 ;TYPE
+1 KILL ^UTILITY("DIQ1",$JOB)
+2 KILL DIQ,DIC,DA,DR
+3 SET DIC="^AUPNVSIT("
SET DR=".03"
SET DA=APCDVDFN
SET DIQ(0)="E"
DO EN^DIQ1
KILL DIC,DA,DR,DIQ
+4 SET APCDSORT=^UTILITY("DIQ1",$JOB,9000010,APCDVDFN,.03,"E")
+5 KILL ^UTILITY("DIQ1",$JOB)
+6 QUIT
+7 ;
DATE ;
+1 SET APCDDATE=$PIECE(APCDODAT,".")
CALDEC ;
+1 SET APCDVDES=0
+2 SET APCDVFLE=9000010
FOR APCDFL=0:0
SET APCDVFLE=$ORDER(^DIC(APCDVFLE))
IF APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE)
QUIT
Begin DoDot:1
+3 IF APCDVFLE=9000010.09
QUIT
+4 IF APCDVFLE=9000010.14
QUIT
+5 IF APCDVFLE=9000010.22
QUIT
+6 IF APCDVFLE=9000010.24
QUIT
+7 IF APCDVFLE=9000010.25
QUIT
+8 IF APCDVFLE=9000010.31
QUIT
+9 IF APCDVFLE=9000010.99
QUIT
+10 SET APCDVDG=^DIC(APCDVFLE,0,"GL")
SET APCDVIGR=APCDVDG_"""AD"",APCDVDFN,APCDEDFN)"
+11 SET APCDEDFN=""
FOR APCDEL=1:1
SET APCDEDFN=$ORDER(@APCDVIGR)
IF APCDEDFN'=+APCDEDFN
QUIT
SET APCDVDES=APCDVDES+1
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
