APCLYV21.m

APCLYV21 ; IHS/CMI/LAB - PRINT OUTPT VISITS WITH ICD CODES (CALC) ;

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

 ;

INIT ;initialize variables

 S APCLJOB=$J,APCLBT=$H

 D XTMP^APCLOSUT("APCLYV2","PCC LIST OF OUTP VISITS")

 S APCLDEN=$O(^DIC(40.7,"C",56,0)) ;dental clinic stop code

 ;

CALC ;find visits by date then store by patient name

 ;

 S APCLVDT=APCLBD-.0001

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

 G END:APCLVDT="",END: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:$$DEMO^APCLUTL($P(APCLSTR,U,5),$G(APCLDEMO))

 I APCLLOC]"",$P(APCLSTR,U,6)'=APCLLOC G VST1 ;screen out other facilities

 ;screen out all but ambulatory, in-hospital, & day surgery

 S X=$P(APCLSTR,"^",7) I X'="A",(X'="I"),(X'="S") G VST1

 I $D(^APCLCNTL(4,11,"B",$P(APCLSTR,"^",3))) G VST1 ;LAB ADDED TO SCREEN OUT C AND V

 I APCLPROV]"" S APCLFOUN=0 D GETPROV G:'APCLFOUN VST1

 G VST1:$P(APCLSTR,"^",8)=APCLDEN ;screen out dental visits

 ;

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

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

 ;

END ;

 S APCLET=$H

 K APCLNAME,APCLSTR

 Q

GETPROV ;check to see if correct provider is either primary or secondary

 NEW X S X=0 S X=$O(^AUPNVPRV("AD",APCLVDFN,X)) Q:X'=+X!(APCLFOUN)  I $P(^AUPNVPRV(X,0),U)=APCLPROV S APCLFOUN=1

 Q

APCLYV21  ; IHS/CMI/LAB - PRINT OUTPT VISITS WITH ICD CODES (CALC) ;

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

 +2       ;

INIT      ;initialize variables

 +1        SET APCLJOB=$JOB

           SET APCLBT=$HOROLOG

 +2        DO XTMP^APCLOSUT("APCLYV2","PCC LIST OF OUTP VISITS")

 +3       ;dental clinic stop code

           SET APCLDEN=$ORDER(^DIC(40.7,"C",56,0))

 +4       ;

CALC      ;find visits by date then store by patient name

 +1       ;

 +2        SET APCLVDT=APCLBD-.0001

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

 +1        IF APCLVDT=""

               GOTO END

           IF APCLVDT>(APCLED+.2359)

               GOTO END

           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 $$DEMO^APCLUTL($PIECE(APCLSTR,U,5),$GET(APCLDEMO))

               GOTO VST1

 +5       ;screen out other facilities

           IF APCLLOC]""

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

                   GOTO VST1

 +6       ;screen out all but ambulatory, in-hospital, & day surgery

 +7        SET X=$PIECE(APCLSTR,"^",7)

           IF X'="A"

               IF (X'="I")

                   IF (X'="S")

                       GOTO VST1

 +8       ;LAB ADDED TO SCREEN OUT C AND V

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

               GOTO VST1

 +9        IF APCLPROV]""

               SET APCLFOUN=0

               DO GETPROV

               IF 'APCLFOUN

                   GOTO VST1

 +10      ;screen out dental visits

           IF $PIECE(APCLSTR,"^",8)=APCLDEN

               GOTO VST1

 +11      ;

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

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

 +13       SET ^XTMP("APCLYV2",APCLJOB,APCLBT,APCLNAME,APCLDFN,APCLVDT,APCLVDFN)=""

           GOTO VST1

 +14      ;

END       ;

 +1        SET APCLET=$HOROLOG

 +2        KILL APCLNAME,APCLSTR

 +3        QUIT 

GETPROV   ;check to see if correct provider is either primary or secondary

 +1        NEW X

           SET X=0

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

           IF X'=+X!(APCLFOUN)

               QUIT 

           IF $PIECE(^AUPNVPRV(X,0),U)=APCLPROV

               SET APCLFOUN=1

 +2        QUIT