- 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 ;
