- 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 ;
