APCLADA1.m

APCLADA1 ; IHS/CMI/LAB - PRINT CLINIC VISITS (CALC) ;

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

 ;

CALC ;find visits by date then store by patient name

 ;

 S APCLJOB=$J,APCLBT=$H

 D XTMP^APCLOSUT("APCLADA","PCC VISITS WITH ADA CODES")

 S APCLVDT=APCLBD-.0001

VST S APCLVDT=$O(^AUPNVSIT("B",APCLVDT))

 G NEXT:APCLVDT="",NEXT:APCLVDT>(APCLED+.2359) S APCLVDFN=0

VST1 S APCLVDFN=$O(^AUPNVSIT("B",APCLVDT,APCLVDFN)) G VST:APCLVDFN=""

 ;

 G VST1:'$D(^AUPNVSIT(APCLVDFN,0)) S APCLSTR=^(0)

 G VST1:$P(APCLSTR,"^",11) ;screen out deleted visits

 G VST1:'$D(^AUPNVDEN("AD",APCLVDFN))

 G VST1:$$DEMO^APCLUTL($P(APCLSTR,U,5),$G(APCLDEMO))

 I APCLLOC]"",$P(APCLSTR,U,6)'=APCLLOC Q

 Q:$P(^DPT($P(^AUPNVSIT(APCLVDFN,0),U,5),0),U)["DEMO,PATIENT"

 G:$D(^APCLCNTL(4,11,"B",$P(APCLSTR,"^",3))) VST1

 I APCLCL'="A" G VST1:$P(APCLSTR,"^",8)'=APCLCL

 S APCLCLX=$S(APCLCL=+APCLCL:APCLCL,1:$P(APCLSTR,"^",8))

 S:APCLCLX="" APCLCLX="E"

 ;

 S APCLDFN=$P(APCLSTR,"^",5),APCLNAME=$P(^DPT(APCLDFN,0),"^")

 S ^XTMP("APCLADA",APCLJOB,APCLBT,APCLCLX,APCLNAME,APCLDFN,APCLVDT,APCLVDFN)="" G VST1

 ;

NEXT ;

 S APCLET=$H

 Q

 ;

APCLADA1  ; IHS/CMI/LAB - PRINT CLINIC VISITS (CALC) ;

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

 +2       ;

CALC      ;find visits by date then store by patient name

 +1       ;

 +2        SET APCLJOB=$JOB

           SET APCLBT=$HOROLOG

 +3        DO XTMP^APCLOSUT("APCLADA","PCC VISITS WITH ADA CODES")

 +4        SET APCLVDT=APCLBD-.0001

VST        SET APCLVDT=$ORDER(^AUPNVSIT("B",APCLVDT))

 +1        IF APCLVDT=""

               GOTO NEXT

           IF APCLVDT>(APCLED+.2359)

               GOTO NEXT

           SET APCLVDFN=0

VST1       SET APCLVDFN=$ORDER(^AUPNVSIT("B",APCLVDT,APCLVDFN))

           IF APCLVDFN=""

               GOTO VST

 +1       ;

 +2        IF '$DATA(^AUPNVSIT(APCLVDFN,0))

               GOTO VST1

           SET APCLSTR=^(0)

 +3       ;screen out deleted visits

           IF $PIECE(APCLSTR,"^",11)

               GOTO VST1

 +4        IF '$DATA(^AUPNVDEN("AD",APCLVDFN))

               GOTO VST1

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

               GOTO VST1

 +6        IF APCLLOC]""

               IF $PIECE(APCLSTR,U,6)'=APCLLOC

                   QUIT 

 +7        IF $PIECE(^DPT($PIECE(^AUPNVSIT(APCLVDFN,0),U,5),0),U)["DEMO,PATIENT"

               QUIT 

 +8        IF $DATA(^APCLCNTL(4,11,"B",$PIECE(APCLSTR,"^",3)))

               GOTO VST1

 +9        IF APCLCL'="A"

               IF $PIECE(APCLSTR,"^",8)'=APCLCL

                   GOTO VST1

 +10       SET APCLCLX=$SELECT(APCLCL=+APCLCL:APCLCL,1:$PIECE(APCLSTR,"^",8))

 +11       IF APCLCLX=""

               SET APCLCLX="E"

 +12      ;

 +13       SET APCLDFN=$PIECE(APCLSTR,"^",5)

           SET APCLNAME=$PIECE(^DPT(APCLDFN,0),"^")

 +14       SET ^XTMP("APCLADA",APCLJOB,APCLBT,APCLCLX,APCLNAME,APCLDFN,APCLVDT,APCLVDFN)=""

           GOTO VST1

 +15      ;

NEXT      ;

 +1        SET APCLET=$HOROLOG

 +2        QUIT 

 +3       ;