APCLOS4 ; IHS/CMI/LAB - AMBULATORY - OPERATIONS SUMMARY ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
AMB ;
S X=999,DIC="^AUTTRCD(",DIC(0)="" D ^DIC S APCLAPCD=$S(Y>0:+Y,1:"")
I $G(APCLMFY)=1!(APCLMFY=3) S X1=APCLFYB,X2=-1 D C^%DTC S APCLSD=X_".9999",APCLED=APCLFYE,APCLOS="APCLOS" D V
I $G(APCLMFY)=2 S APCLSD=APCL("FY WORKING DT"),APCLED=APCLFYE,APCLOS="APCLOS" D V
D SET^APCLOSUT
S X1=APCLPYB,X2=-1 D C^%DTC S APCLSD=X_".9999",APCLED=APCLPYE,APCLOS="APCLOSP" D V
D SET^APCLOSUT
EOJ ;ENTRY POINT
K APCLSD,APCLODAT,APCLED,APCLVDFN,APCLVREC,APCLINJF,APCLALCH,APCLVLOC,APCL1,APCL2,APCLAP,APCLTYPE,APCLCAT,APCLVLOC,APCLCLNC,APCLCLIN,APCLDDFN,APCLDENT,APCLF,APCLPOV,APCLINJ,APCLAPC,G
K APCLX,APCLPROV,APCLY,APCLDISC,APCLPDFN,APCLA,APCLH,APCLD,APCLAMB,APCLEDAT,APCLL,APCLS,APCLC,APCLT,APCLP,APCLF,APCLH,APCLAPCD
Q
V ;
S %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,",APCLA=%_"""AMBPOV"",APCLPOV)"
S %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,",APCLH=%_"""AMBAPC"",APCLAPC)"
S %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,",APCLD=%_"""AMBINJCAUSE"",APCLINJ)"
S %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,",APCLF=%_"""DENTPOV"",APCLDENT)"
S %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,",APCLP=%_"""AMBPROV"",APCLDISC)"
S %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,",APCLT=%_"""AMBTYPE"",APCLTYPE)"
S %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,",APCLL=%_"""AMBLOC"",APCLVLOC)"
S %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,",APCLS=%_"""AMBCAT"",APCLCAT)"
S %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,",APCLC=%_"""AMBCLIN"",APCLCLIN)"
S APCLODAT=APCLSD F S APCLODAT=$O(^AUPNVSIT("B",APCLODAT)) Q:APCLODAT=""!((APCLODAT\1)>APCLED) D V1
Q
V1 ;
S APCLVDFN="" F S APCLVDFN=$O(^AUPNVSIT("B",APCLODAT,APCLVDFN)) Q:APCLVDFN'=+APCLVDFN I $D(^AUPNVSIT(APCLVDFN,0)) S APCLVREC=^(0) D PROC
Q
PROC ;
K APCLINJF,APCLALCH
Q:$$DEMO^APCLUTL($P(APCLVREC,U,5),$G(APCLDEMO))
Q:'$P(APCLVREC,U,9)
Q:$P(APCLVREC,U,11)
Q:"DXEIH"[$P(APCLVREC,U,7)
I $P(APCLVREC,U,3)="" Q
Q:$D(^APCLCNTL(4,11,"B",$P(APCLVREC,U,3))) ;LAB/OHPRD CHANGED CV TO C FOR VA
S APCLVLOC=$P(APCLVREC,U,6) Q:APCLVLOC=""
Q:'$D(^XTMP("APCLSU",APCLJOB,APCLBTH,APCLVLOC))
Q:'$D(^AUPNVPOV("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)
Q:APCL1=0
Q:APCL1>1
I $P(APCLVREC,U,7)="C" S ^("CHART REVIEWS")=$S($D(^XTMP(APCLOS,APCLJOB,APCLBTH,"CHART REVIEWS")):(+^("CHART REVIEWS")+1),1:1) Q
S ^("AMBVCOUNT")=$S($D(^XTMP(APCLOS,APCLJOB,APCLBTH,"AMBVCOUNT")):(+^("AMBVCOUNT")+1),1:1)
TYPE K ^UTILITY("DIQ1",$J)
K DIQ,DIC,DA,DR
S DIC="^AUPNVSIT(",DR=".03",DA=APCLVDFN,DIQ(0)="E" D EN^DIQ1 K DIC,DA,DR,DIQ
S APCLTYPE=^UTILITY("DIQ1",$J,9000010,APCLVDFN,.03,"E")
S X=APCLT D COUNT
SC ;
K ^UTILITY("DIQ1",$J)
K DIQ,DIC,DA,DR
S DIC="^AUPNVSIT(",DR=".07",DA=APCLVDFN,DIQ(0)="E" D EN^DIQ1 K DIC,DA,DR,DIQ
S APCLCAT=^UTILITY("DIQ1",$J,9000010,APCLVDFN,.07,"E")
S X=APCLS D COUNT
K ^UTILITY("DIQ1",$J)
LOC ;
S X=APCLL D COUNT
CLINIC ;
S APCLCLIN=$P(APCLVREC,U,8) I APCLCLIN="" S APCLCLIN="NO CLINIC",APCLCLNC="" G SETCLIN
S APCLCLNC=$P(^DIC(40.7,APCLCLIN,0),U,2),APCLCLIN=$P(^DIC(40.7,APCLCLIN,0),U)
SETCLIN ;
S X=APCLC D COUNT
I APCLCLNC=30 S ^("ERCOUNT")=$S($D(^XTMP(APCLOS,APCLJOB,APCLBTH,"ERCOUNT")):(+^("ERCOUNT")+1),1:1)
I APCLCLNC=56 D DENTAL
;
PROV D ^APCLOS41
Q
DENTAL ;
S ^("DENTVCOUNT")=$S($D(^XTMP(APCLOS,APCLJOB,APCLBTH,"DENTVCOUNT")):(+^("DENTVCOUNT")+1),1:1)
S APCLDDFN=0 F S APCLDDFN=$O(^AUPNVDEN("AD",APCLVDFN,APCLDDFN)) Q:APCLDDFN'=+APCLDDFN I $D(^AUPNVDEN(APCLDDFN,0)) D DENTAL1
Q
DENTAL1 ;
S APCLDENT=$P(^AUPNVDEN(APCLDDFN,0),U)
S X=APCLF D COUNT
;
Q:$D(^XTMP(APCLOS,APCLJOB,APCLBTH,"DENTPAT",$P(^AUPNVDEN(APCLDDFN,0),U,2)))
S ^XTMP(APCLOS,APCLJOB,APCLBTH,"DENTPAT",$P(^AUPNVDEN(APCLDDFN,0),U,2))=""
S ^("DENTPATCOUNT")=$S($D(^XTMP(APCLOS,APCLJOB,APCLBTH,"DENTPATCOUNT")):(+^("DENTPATCOUNT")+1),1:1)
Q
COUNT ;
I '$D(@X) S @X=0
S %=@X,%=%+1,@X=%
Q
APCLOS4 ; IHS/CMI/LAB - AMBULATORY - OPERATIONS SUMMARY ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
AMB ;
+1 SET X=999
SET DIC="^AUTTRCD("
SET DIC(0)=""
DO ^DIC
SET APCLAPCD=$SELECT(Y>0:+Y,1:"")
+2 IF $GET(APCLMFY)=1!(APCLMFY=3)
SET X1=APCLFYB
SET X2=-1
DO C^%DTC
SET APCLSD=X_".9999"
SET APCLED=APCLFYE
SET APCLOS="APCLOS"
DO V
+3 IF $GET(APCLMFY)=2
SET APCLSD=APCL("FY WORKING DT")
SET APCLED=APCLFYE
SET APCLOS="APCLOS"
DO V
+4 DO SET^APCLOSUT
+5 SET X1=APCLPYB
SET X2=-1
DO C^%DTC
SET APCLSD=X_".9999"
SET APCLED=APCLPYE
SET APCLOS="APCLOSP"
DO V
+6 DO SET^APCLOSUT
EOJ ;ENTRY POINT
+1 KILL APCLSD,APCLODAT,APCLED,APCLVDFN,APCLVREC,APCLINJF,APCLALCH,APCLVLOC,APCL1,APCL2,APCLAP,APCLTYPE,APCLCAT,APCLVLOC,APCLCLNC,APCLCLIN,APCLDDFN,APCLDENT,APCLF,APCLPOV,APCLINJ,APCLAPC,G
+2 KILL APCLX,APCLPROV,APCLY,APCLDISC,APCLPDFN,APCLA,APCLH,APCLD,APCLAMB,APCLEDAT,APCLL,APCLS,APCLC,APCLT,APCLP,APCLF,APCLH,APCLAPCD
+3 QUIT
V ;
+1 SET %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"
SET APCLA=%_"""AMBPOV"",APCLPOV)"
+2 SET %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"
SET APCLH=%_"""AMBAPC"",APCLAPC)"
+3 SET %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"
SET APCLD=%_"""AMBINJCAUSE"",APCLINJ)"
+4 SET %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"
SET APCLF=%_"""DENTPOV"",APCLDENT)"
+5 SET %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"
SET APCLP=%_"""AMBPROV"",APCLDISC)"
+6 SET %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"
SET APCLT=%_"""AMBTYPE"",APCLTYPE)"
+7 SET %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"
SET APCLL=%_"""AMBLOC"",APCLVLOC)"
+8 SET %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"
SET APCLS=%_"""AMBCAT"",APCLCAT)"
+9 SET %="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"
SET APCLC=%_"""AMBCLIN"",APCLCLIN)"
+10 SET APCLODAT=APCLSD
FOR
SET APCLODAT=$ORDER(^AUPNVSIT("B",APCLODAT))
IF APCLODAT=""!((APCLODAT\1)>APCLED)
QUIT
DO V1
+11 QUIT
V1 ;
+1 SET APCLVDFN=""
FOR
SET APCLVDFN=$ORDER(^AUPNVSIT("B",APCLODAT,APCLVDFN))
IF APCLVDFN'=+APCLVDFN
QUIT
IF $DATA(^AUPNVSIT(APCLVDFN,0))
SET APCLVREC=^(0)
DO PROC
+2 QUIT
PROC ;
+1 KILL APCLINJF,APCLALCH
+2 IF $$DEMO^APCLUTL($PIECE(APCLVREC,U,5),$GET(APCLDEMO))
QUIT
+3 IF '$PIECE(APCLVREC,U,9)
QUIT
+4 IF $PIECE(APCLVREC,U,11)
QUIT
+5 IF "DXEIH"[$PIECE(APCLVREC,U,7)
QUIT
+6 IF $PIECE(APCLVREC,U,3)=""
QUIT
+7 ;LAB/OHPRD CHANGED CV TO C FOR VA
IF $DATA(^APCLCNTL(4,11,"B",$PIECE(APCLVREC,U,3)))
QUIT
+8 SET APCLVLOC=$PIECE(APCLVREC,U,6)
IF APCLVLOC=""
QUIT
+9 IF '$DATA(^XTMP("APCLSU",APCLJOB,APCLBTH,APCLVLOC))
QUIT
+10 IF '$DATA(^AUPNVPOV("AD",APCLVDFN))
QUIT
+11 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)
+12 IF APCL1=0
QUIT
+13 IF APCL1>1
QUIT
+14 IF $PIECE(APCLVREC,U,7)="C"
SET ^("CHART REVIEWS")=$SELECT($DATA(^XTMP(APCLOS,APCLJOB,APCLBTH,"CHART REVIEWS")):(+^("CHART REVIEWS")+1),1:1)
QUIT
+15 SET ^("AMBVCOUNT")=$SELECT($DATA(^XTMP(APCLOS,APCLJOB,APCLBTH,"AMBVCOUNT")):(+^("AMBVCOUNT")+1),1:1)
TYPE KILL ^UTILITY("DIQ1",$JOB)
+1 KILL DIQ,DIC,DA,DR
+2 SET DIC="^AUPNVSIT("
SET DR=".03"
SET DA=APCLVDFN
SET DIQ(0)="E"
DO EN^DIQ1
KILL DIC,DA,DR,DIQ
+3 SET APCLTYPE=^UTILITY("DIQ1",$JOB,9000010,APCLVDFN,.03,"E")
+4 SET X=APCLT
DO COUNT
SC ;
+1 KILL ^UTILITY("DIQ1",$JOB)
+2 KILL DIQ,DIC,DA,DR
+3 SET DIC="^AUPNVSIT("
SET DR=".07"
SET DA=APCLVDFN
SET DIQ(0)="E"
DO EN^DIQ1
KILL DIC,DA,DR,DIQ
+4 SET APCLCAT=^UTILITY("DIQ1",$JOB,9000010,APCLVDFN,.07,"E")
+5 SET X=APCLS
DO COUNT
+6 KILL ^UTILITY("DIQ1",$JOB)
LOC ;
+1 SET X=APCLL
DO COUNT
CLINIC ;
+1 SET APCLCLIN=$PIECE(APCLVREC,U,8)
IF APCLCLIN=""
SET APCLCLIN="NO CLINIC"
SET APCLCLNC=""
GOTO SETCLIN
+2 SET APCLCLNC=$PIECE(^DIC(40.7,APCLCLIN,0),U,2)
SET APCLCLIN=$PIECE(^DIC(40.7,APCLCLIN,0),U)
SETCLIN ;
+1 SET X=APCLC
DO COUNT
+2 IF APCLCLNC=30
SET ^("ERCOUNT")=$SELECT($DATA(^XTMP(APCLOS,APCLJOB,APCLBTH,"ERCOUNT")):(+^("ERCOUNT")+1),1:1)
+3 IF APCLCLNC=56
DO DENTAL
+4 ;
PROV DO ^APCLOS41
+1 QUIT
DENTAL ;
+1 SET ^("DENTVCOUNT")=$SELECT($DATA(^XTMP(APCLOS,APCLJOB,APCLBTH,"DENTVCOUNT")):(+^("DENTVCOUNT")+1),1:1)
+2 SET APCLDDFN=0
FOR
SET APCLDDFN=$ORDER(^AUPNVDEN("AD",APCLVDFN,APCLDDFN))
IF APCLDDFN'=+APCLDDFN
QUIT
IF $DATA(^AUPNVDEN(APCLDDFN,0))
DO DENTAL1
+3 QUIT
DENTAL1 ;
+1 SET APCLDENT=$PIECE(^AUPNVDEN(APCLDDFN,0),U)
+2 SET X=APCLF
DO COUNT
+3 ;
+4 IF $DATA(^XTMP(APCLOS,APCLJOB,APCLBTH,"DENTPAT",$PIECE(^AUPNVDEN(APCLDDFN,0),U,2)))
QUIT
+5 SET ^XTMP(APCLOS,APCLJOB,APCLBTH,"DENTPAT",$PIECE(^AUPNVDEN(APCLDDFN,0),U,2))=""
+6 SET ^("DENTPATCOUNT")=$SELECT($DATA(^XTMP(APCLOS,APCLJOB,APCLBTH,"DENTPATCOUNT")):(+^("DENTPATCOUNT")+1),1:1)
+7 QUIT
COUNT ;
+1 IF '$DATA(@X)
SET @X=0
+2 SET %=@X
SET %=%+1
SET @X=%
+3 QUIT
