- 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
