APCLCAW1.m

APCLCAW1 ; IHS/CMI/LAB -CLINIC VISITS CONT. APCLCAW ;

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

 S APCLJOB=$J,APCLBT=$H

 D XTMP^APCLOSUT("APCLCAW","PCC - APPT/WI TALLY")

V ; Run by visit date

 S APCLODAT=$O(^AUPNVSIT("B",APCLSD)) I APCLODAT="" S APCLET=$H Q

 S APCLODAT=APCLSD_".9999" F  S APCLODAT=$O(^AUPNVSIT("B",APCLODAT)) Q:APCLODAT=""!((APCLODAT\1)>APCLED)  D V1

 S APCLET=$H

 Q

V1 ;

 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,EOJ

 Q

PROC ;

 K APCLSKIP

 Q:$$DEMO^APCLUTL($P(APCLVREC,U,5),$G(APCLDEMO))

 Q:"XECIHD"[$P(APCLVREC,U,7)

 Q:$D(^APCLCNTL(4,11,"B",$P(APCLVREC,U,3)))

 S APCLVLOC=$P(APCLVREC,U,6) Q:APCLVLOC=""

 Q:$P(APCLVREC,U,8)=""

 I $$CHKLOC^APCLOCCK(APCLLOC,APCLVLOC)=0 Q

 ;I APCLCLN]"",$P(APCLVREC,U,8)'=APCLCLN Q

 I $G(APCLCLN)'="A",'$D(APCLCLN($P(APCLVREC,U,8))) Q  ;IHS/CMI/LAB

 S APCLCLIN=$P(APCLVREC,U,8)

 Q:'$D(^AUPNVPOV("AD",APCLVDFN))

 Q:'$D(^AUPNVPRV("AD",APCLVDFN))

 S (APCL1,APCL2)=0 F  S APCL2=$O(^AUPNVPRV("AD",APCLVDFN,APCL2)) Q:APCL2=""  I $P(^AUPNVPRV(APCL2,0),U,4)="P" S APCL1=APCL1+1,APCLAP=$P(^(0),U)

 I APCL1=0 Q

 I APCL1>1 Q

 D CLIN

 S ^(APCLSRT3)=$S($D(^XTMP("APCLCAW",APCLJOB,APCLBT,"LOCTOT",APCLVLOC,APCLCLIN,APCLSRT2,APCLSRT3)):^(APCLSRT3)+1,1:1)

 Q

EOJ K APCLVLOC,APCLVREC,APCLCLIN,APCLSKIP,APCL1,APCL2,APCLAP,APCLDISC,APCLPPOV,APCLX,APCLHIGH,APCLDX,APCLLOW,APCLICD,APCLDA1,APCLDA2,APCLY,APCLSRT2,APCLDATE,APCLPROV,APCLSEC,APCLZ

 Q

 ;

CLIN S APCLSRT2=$P(^DIC(40.7,APCLCLIN,0),U,2),APCLCLIN=$P(^DIC(40.7,APCLCLIN,0),U),APCLSRT3=$S($P(APCLVREC,U,16)="":"U",1:$P(APCLVREC,U,16))

 Q

 ;

APCLCAW1  ; IHS/CMI/LAB -CLINIC VISITS CONT. APCLCAW ;

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

 +2        SET APCLJOB=$JOB

           SET APCLBT=$HOROLOG

 +3        DO XTMP^APCLOSUT("APCLCAW","PCC - APPT/WI TALLY")

V         ; Run by visit date

 +1        SET APCLODAT=$ORDER(^AUPNVSIT("B",APCLSD))

           IF APCLODAT=""

               SET APCLET=$HOROLOG

               QUIT 

 +2        SET APCLODAT=APCLSD_".9999"

           FOR 

               SET APCLODAT=$ORDER(^AUPNVSIT("B",APCLODAT))

               IF APCLODAT=""!((APCLODAT\1)>APCLED)

                   QUIT 

               DO V1

 +3        SET APCLET=$HOROLOG

 +4        QUIT 

V1        ;

 +1        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

                           DO EOJ

 +2        QUIT 

PROC      ;

 +1        KILL APCLSKIP

 +2        IF $$DEMO^APCLUTL($PIECE(APCLVREC,U,5),$GET(APCLDEMO))

               QUIT 

 +3        IF "XECIHD"[$PIECE(APCLVREC,U,7)

               QUIT 

 +4        IF $DATA(^APCLCNTL(4,11,"B",$PIECE(APCLVREC,U,3)))

               QUIT 

 +5        SET APCLVLOC=$PIECE(APCLVREC,U,6)

           IF APCLVLOC=""

               QUIT 

 +6        IF $PIECE(APCLVREC,U,8)=""

               QUIT 

 +7        IF $$CHKLOC^APCLOCCK(APCLLOC,APCLVLOC)=0

               QUIT 

 +8       ;I APCLCLN]"",$P(APCLVREC,U,8)'=APCLCLN Q

 +9       ;IHS/CMI/LAB

           IF $GET(APCLCLN)'="A"

               IF '$DATA(APCLCLN($PIECE(APCLVREC,U,8)))

                   QUIT 

 +10       SET APCLCLIN=$PIECE(APCLVREC,U,8)

 +11       IF '$DATA(^AUPNVPOV("AD",APCLVDFN))

               QUIT 

 +12       IF '$DATA(^AUPNVPRV("AD",APCLVDFN))

               QUIT 

 +13       SET (APCL1,APCL2)=0

           FOR 

               SET APCL2=$ORDER(^AUPNVPRV("AD",APCLVDFN,APCL2))

               IF APCL2=""

                   QUIT 

               IF $PIECE(^AUPNVPRV(APCL2,0),U,4)="P"

                   SET APCL1=APCL1+1

                   SET APCLAP=$PIECE(^(0),U)

 +14       IF APCL1=0

               QUIT 

 +15       IF APCL1>1

               QUIT 

 +16       DO CLIN

 +17       SET ^(APCLSRT3)=$SELECT($DATA(^XTMP("APCLCAW",APCLJOB,APCLBT,"LOCTOT",APCLVLOC,APCLCLIN,APCLSRT2,APCLSRT3)):^(APCLSRT3)+1,1:1)

 +18       QUIT 

EOJ        KILL APCLVLOC,APCLVREC,APCLCLIN,APCLSKIP,APCL1,APCL2,APCLAP,APCLDISC,APCLPPOV,APCLX,APCLHIGH,APCLDX,APCLLOW,APCLICD,APCLDA1,APCLDA2,APCLY,APCLSRT2,APCLDATE,APCLPROV,APCLSEC,APCLZ

 +1        QUIT 

 +2       ;

CLIN       SET APCLSRT2=$PIECE(^DIC(40.7,APCLCLIN,0),U,2)

           SET APCLCLIN=$PIECE(^DIC(40.7,APCLCLIN,0),U)

           SET APCLSRT3=$SELECT($PIECE(APCLVREC,U,16)="":"U",1:$PIECE(APCLVREC,U,16))

 +1        QUIT 

 +2       ;