APCDFCT1.m

APCDFCT1 ; IHS/CMI/LAB - FORMS COUNT (FILE) report process ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 S APCDJOB=$J,APCDBT=$H

 S ^XTMP("APCDFCT",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"PCC DE TRANS CODE REPORT"

P ; Run by posting date

 S APCDODAT=APCDSD_".9999" F  S APCDODAT=$O(^APCDTCT("B",APCDODAT)) Q:APCDODAT=""!((APCDODAT\1)>APCDED)  S APCDDFN=$O(^APCDTCT("B",APCDODAT,"")) D V1

 Q

V1 ;

 S APCDC=0 F  S APCDC=$O(^APCDTCT(APCDDFN,11,APCDC)) Q:APCDC'=+APCDC  S APCDVDFN=$P(^APCDTCT(APCDDFN,11,APCDC,0),U) I APCDVDFN]"",$D(^AUPNVSIT(APCDVDFN,0)) D PROC

 Q

PROC ;

 I APCDDEC'="ALL",APCDDEC'=$P(^APCDTCT(APCDDFN,11,APCDC,0),U,2) Q

 Q:$P(^APCDTCT(APCDDFN,11,APCDC,0),U,2)=""

 Q:'$D(^VA(200,$P(^APCDTCT(APCDDFN,11,APCDC,0),U,2),0))

 S APCDAP=$P(^VA(200,$P(^APCDTCT(APCDDFN,11,APCDC,0),U,2),0),U),APCDTC=$P(^APCDTCT(APCDDFN,11,APCDC,0),U,3)

 S APCDVREC=^AUPNVSIT(APCDVDFN,0)

 Q:'$P(APCDVREC,U,9)

 Q:$P(APCDVREC,U,11)

 D @APCDPROC

 S APCDDATE=$P(APCDODAT,".")

SET S ^(APCDDATE)=$S($D(^XTMP("APCDFCT",APCDJOB,APCDBT,APCDAP,APCDSORT,APCDDATE)):^(APCDDATE)+1,1:1)

 S ^(APCDDATE)=$S($D(^XTMP("APCDFCT",APCDJOB,APCDBT,APCDAP,APCDSORT,"DEP COUNT",APCDDATE)):^(APCDDATE)+APCDTC,1:APCDTC)

 Q

EOJ ; clean up and exit

 K APCDVREC,APCDCLIN,APCDSKIP,APCD1,APCD2,APCDAP,APCDX,APCDY,APCDTC,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

 ;

 ;

APCDFCT1  ; IHS/CMI/LAB - FORMS COUNT (FILE) report process ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2        SET APCDJOB=$JOB

           SET APCDBT=$HOROLOG

 +3        SET ^XTMP("APCDFCT",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"PCC DE TRANS CODE REPORT"

P         ; Run by posting date

 +1        SET APCDODAT=APCDSD_".9999"

           FOR 

               SET APCDODAT=$ORDER(^APCDTCT("B",APCDODAT))

               IF APCDODAT=""!((APCDODAT\1)>APCDED)

                   QUIT 

               SET APCDDFN=$ORDER(^APCDTCT("B",APCDODAT,""))

               DO V1

 +2        QUIT 

V1        ;

 +1        SET APCDC=0

           FOR 

               SET APCDC=$ORDER(^APCDTCT(APCDDFN,11,APCDC))

               IF APCDC'=+APCDC

                   QUIT 

               SET APCDVDFN=$PIECE(^APCDTCT(APCDDFN,11,APCDC,0),U)

               IF APCDVDFN]""

                   IF $DATA(^AUPNVSIT(APCDVDFN,0))

                       DO PROC

 +2        QUIT 

PROC      ;

 +1        IF APCDDEC'="ALL"

               IF APCDDEC'=$PIECE(^APCDTCT(APCDDFN,11,APCDC,0),U,2)

                   QUIT 

 +2        IF $PIECE(^APCDTCT(APCDDFN,11,APCDC,0),U,2)=""

               QUIT 

 +3        IF '$DATA(^VA(200,$PIECE(^APCDTCT(APCDDFN,11,APCDC,0),U,2),0))

               QUIT 

 +4        SET APCDAP=$PIECE(^VA(200,$PIECE(^APCDTCT(APCDDFN,11,APCDC,0),U,2),0),U)

           SET APCDTC=$PIECE(^APCDTCT(APCDDFN,11,APCDC,0),U,3)

 +5        SET APCDVREC=^AUPNVSIT(APCDVDFN,0)

 +6        IF '$PIECE(APCDVREC,U,9)

               QUIT 

 +7        IF $PIECE(APCDVREC,U,11)

               QUIT 

 +8        DO @APCDPROC

 +9        SET APCDDATE=$PIECE(APCDODAT,".")

SET        SET ^(APCDDATE)=$SELECT($DATA(^XTMP("APCDFCT",APCDJOB,APCDBT,APCDAP,APCDSORT,APCDDATE)):^(APCDDATE)+1,1:1)

 +1        SET ^(APCDDATE)=$SELECT($DATA(^XTMP("APCDFCT",APCDJOB,APCDBT,APCDAP,APCDSORT,"DEP COUNT",APCDDATE)):^(APCDDATE)+APCDTC,1:APCDTC)

 +2        QUIT 

EOJ       ; clean up and exit

 +1        KILL APCDVREC,APCDCLIN,APCDSKIP,APCD1,APCD2,APCDAP,APCDX,APCDY,APCDTC,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       ;

 +8       ;