APCDFOS1 ; IHS/CMI/LAB - FORMS TRACKING SUMMARY ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;FILE 200 CONV
S APCDJ=$J,APCDBT=$H,APCDTOT=0
P ; Run by posting date
S APCDODAT=APCDSD_".9999" F S APCDODAT=$O(^APCDFORM("B",APCDODAT)) Q:APCDODAT=""!((APCDODAT\1)>APCDED) S APCDDFN=$O(^APCDFORM("B",APCDODAT,"")) D V1
Q
V1 ;
S APCDC=0 F S APCDC=$O(^APCDFORM(APCDDFN,11,APCDC)) Q:APCDC'=+APCDC S APCDO=$P(^APCDFORM(APCDDFN,11,APCDC,0),U,2),APCDVDFN=$P(^(0),U) I APCDVDFN]"",$D(^AUPNVSIT(APCDVDFN,0)) S APCDR=^AUPNVSIT(APCDVDFN,0) D PROC
Q
PROC ;
S APCDLOC=$P(APCDR,U,6),APCDLOC=$P(^DIC(4,APCDLOC,0),U),APCDTYPE=$P(APCDR,U,3),APCDTYPE=$$EXTSET^XBFUNC(9000010,.03,APCDTYPE),APCDCAT=$P(APCDR,U,7),APCDCAT=$$EXTSET^XBFUNC(9000010,.07,APCDCAT)
S APCDCLN=$P(APCDR,U,8) S APCDCLN=$S(APCDCLN:$P(^DIC(40.7,APCDCLN,0),U),1:"<none>") S APCDO=$S(APCDO:$P(^VA(200,APCDO,0),U),1:"??")
S APCDTOT=APCDTOT+1
D DEP
D OPER
D LOC
I $P(APCDR,U,3)="C" D CHS Q
I $P(APCDR,U,7)="H" D HOSP Q
I $P(APCDR,U,7)="I" D INHOSP Q
D AMB
Q
CHS ;
S ^("TOTAL")=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"CHS","TOTAL")):^("TOTAL")+1,1:1)
S ^(APCDLOC)=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"CHS","LOC",APCDLOC)):^(APCDLOC)+1,1:1)
S ^(APCDCAT)=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"CHS","CAT",APCDCAT)):^(APCDCAT)+1,1:1)
Q
HOSP ;
S ^("TOTAL")=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"HOSP","TOTAL")):^("TOTAL")+1,1:1)
S ^(APCDLOC)=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"HOSP","LOC",APCDLOC)):^(APCDLOC)+1,1:1)
S ^(APCDTYPE)=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"HOSP","TYPE",APCDTYPE)):^(APCDTYPE)+1,1:1)
Q
INHOSP ;
S ^("TOTAL")=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"INHOSP","TOTAL")):^("TOTAL")+1,1:1)
S ^(APCDLOC)=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"INHOSP","LOC",APCDLOC)):^(APCDLOC)+1,1:1)
S ^(APCDTYPE)=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"INHOSP","TYPE",APCDTYPE)):^(APCDTYPE)+1,1:1)
Q
AMB ;
S ^("TOTAL")=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"AMB","TOTAL")):^("TOTAL")+1,1:1)
S ^(APCDLOC)=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"AMB","LOC",APCDLOC)):^(APCDLOC)+1,1:1)
S ^(APCDCLN)=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"AMB","CLN",APCDCLN)):^(APCDCLN)+1,1:1)
S ^(APCDTYPE)=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"AMB","TYPE",APCDTYPE)):^(APCDTYPE)+1,1:1)
S ^(APCDCAT)=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"AMB","CAT",APCDCAT)):^(APCDCAT)+1,1:1)
S X=0 F S X=$O(^AUPNVPRV("AD",APCDVDFN,X)) Q:X'=+X D
.S P=$P(^AUPNVPRV(X,0),U) D
..I $P(^DD(9000010.06,.01,0),U,2)[6 D CHKDISC6 Q
..S APCDD=$$PROVCLS^XBFUNC1(P,"E")
.S ^(APCDD)=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"AMB","PROV",APCDD)):^(APCDD)+1,1:1)
.Q
Q
DEP ;tally dependent entries
;excludes LABS,MEDS,RADS,DENTALS
N F,I,G,R,V,N
S F=9000010 F S F=$O(^DIC(F)) Q:F>9000010.99 D
.Q:F=9000010.04
.Q:F=9000010.09
.Q:F=9000010.14
.Q:F=9000010.22
.S N=$P(^DIC(F,0),U)
.S G=^DIC(F,0,"GL"),R=G_"""AD"",APCDVDFN,I)"
.S I=0 F S I=$O(@R) Q:I="" D
..S ^(N)=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"DEP","FILE",N)):^(N)+1,1:1)
..S ^("TOTAL")=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"DEP","TOTAL")):^("TOTAL")+1,1:1)
..Q
.Q
Q
;
OPER ;
S ^("TOTAL")=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"OPER",APCDO,"TOTAL")):^("TOTAL")+1,1:1)
S ^(APCDLOC)=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"OPER",APCDO,"LOC",APCDLOC)):^(APCDLOC)+1,1:1)
S ^(APCDTYPE)=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"OPER",APCDO,"TYPE",APCDTYPE)):^(APCDTYPE)+1,1:1)
S ^(APCDCAT)=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"OPER",APCDO,"CAT",APCDCAT)):^(APCDCAT)+1,1:1)
Q
LOC ;
S ^("TOTAL")=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"LOC",APCDLOC,"TOTAL")):^("TOTAL")+1,1:1)
S ^(APCDCLN)=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"LOC",APCDLOC,"CLN",APCDCLN)):^(APCDCLN)+1,1:1)
S ^(APCDTYPE)=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"LOC",APCDLOC,"TYPE",APCDTYPE)):^(APCDTYPE)+1,1:1)
S ^(APCDCAT)=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"LOC",APCDLOC,"CAT",APCDCAT)):^(APCDCAT)+1,1:1)
S X=0 F S X=$O(^AUPNVPRV("AD",APCDVDFN,X)) Q:X'=+X D
.S P=$P(^AUPNVPRV(X,0),U) D
..I $P(^DD(9000010.06,.01,0),U,2)[6 D CHKDISC6 Q
..S APCDD=$$PROVCLS^XBFUNC1(P,"E")
.S ^(APCDD)=$S($D(^XTMP("APCDFOS",APCDJ,APCDBT,"LOC",APCDLOC,"PROV",APCDD)):^(APCDD)+1,1:1)
.Q
Q
CHKDISC6 ;
NEW Y
I '$D(^DIC(6,P)) S APCDD="??" Q
S Y=$P(^DIC(6,P,0),U,4)
I Y="" S APCDD="??" Q
I '$D(^DIC(7,Y,9999999)) S APCDD="??" Q
S APCDD=$P(^DIC(7,Y,0),U) I APCDD="" S APCDD="??" Q
Q
APCDFOS1 ; IHS/CMI/LAB - FORMS TRACKING SUMMARY ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;FILE 200 CONV
+3 SET APCDJ=$JOB
SET APCDBT=$HOROLOG
SET APCDTOT=0
P ; Run by posting date
+1 SET APCDODAT=APCDSD_".9999"
FOR
SET APCDODAT=$ORDER(^APCDFORM("B",APCDODAT))
IF APCDODAT=""!((APCDODAT\1)>APCDED)
QUIT
SET APCDDFN=$ORDER(^APCDFORM("B",APCDODAT,""))
DO V1
+2 QUIT
V1 ;
+1 SET APCDC=0
FOR
SET APCDC=$ORDER(^APCDFORM(APCDDFN,11,APCDC))
IF APCDC'=+APCDC
QUIT
SET APCDO=$PIECE(^APCDFORM(APCDDFN,11,APCDC,0),U,2)
SET APCDVDFN=$PIECE(^(0),U)
IF APCDVDFN]""
IF $DATA(^AUPNVSIT(APCDVDFN,0))
SET APCDR=^AUPNVSIT(APCDVDFN,0)
DO PROC
+2 QUIT
PROC ;
+1 SET APCDLOC=$PIECE(APCDR,U,6)
SET APCDLOC=$PIECE(^DIC(4,APCDLOC,0),U)
SET APCDTYPE=$PIECE(APCDR,U,3)
SET APCDTYPE=$$EXTSET^XBFUNC(9000010,.03,APCDTYPE)
SET APCDCAT=$PIECE(APCDR,U,7)
SET APCDCAT=$$EXTSET^XBFUNC(9000010,.07,APCDCAT)
+2 SET APCDCLN=$PIECE(APCDR,U,8)
SET APCDCLN=$SELECT(APCDCLN:$PIECE(^DIC(40.7,APCDCLN,0),U),1:"<none>")
SET APCDO=$SELECT(APCDO:$PIECE(^VA(200,APCDO,0),U),1:"??")
+3 SET APCDTOT=APCDTOT+1
+4 DO DEP
+5 DO OPER
+6 DO LOC
+7 IF $PIECE(APCDR,U,3)="C"
DO CHS
QUIT
+8 IF $PIECE(APCDR,U,7)="H"
DO HOSP
QUIT
+9 IF $PIECE(APCDR,U,7)="I"
DO INHOSP
QUIT
+10 DO AMB
+11 QUIT
CHS ;
+1 SET ^("TOTAL")=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"CHS","TOTAL")):^("TOTAL")+1,1:1)
+2 SET ^(APCDLOC)=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"CHS","LOC",APCDLOC)):^(APCDLOC)+1,1:1)
+3 SET ^(APCDCAT)=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"CHS","CAT",APCDCAT)):^(APCDCAT)+1,1:1)
+4 QUIT
HOSP ;
+1 SET ^("TOTAL")=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"HOSP","TOTAL")):^("TOTAL")+1,1:1)
+2 SET ^(APCDLOC)=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"HOSP","LOC",APCDLOC)):^(APCDLOC)+1,1:1)
+3 SET ^(APCDTYPE)=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"HOSP","TYPE",APCDTYPE)):^(APCDTYPE)+1,1:1)
+4 QUIT
INHOSP ;
+1 SET ^("TOTAL")=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"INHOSP","TOTAL")):^("TOTAL")+1,1:1)
+2 SET ^(APCDLOC)=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"INHOSP","LOC",APCDLOC)):^(APCDLOC)+1,1:1)
+3 SET ^(APCDTYPE)=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"INHOSP","TYPE",APCDTYPE)):^(APCDTYPE)+1,1:1)
+4 QUIT
AMB ;
+1 SET ^("TOTAL")=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"AMB","TOTAL")):^("TOTAL")+1,1:1)
+2 SET ^(APCDLOC)=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"AMB","LOC",APCDLOC)):^(APCDLOC)+1,1:1)
+3 SET ^(APCDCLN)=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"AMB","CLN",APCDCLN)):^(APCDCLN)+1,1:1)
+4 SET ^(APCDTYPE)=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"AMB","TYPE",APCDTYPE)):^(APCDTYPE)+1,1:1)
+5 SET ^(APCDCAT)=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"AMB","CAT",APCDCAT)):^(APCDCAT)+1,1:1)
+6 SET X=0
FOR
SET X=$ORDER(^AUPNVPRV("AD",APCDVDFN,X))
IF X'=+X
QUIT
Begin DoDot:1
+7 SET P=$PIECE(^AUPNVPRV(X,0),U)
Begin DoDot:2
+8 IF $PIECE(^DD(9000010.06,.01,0),U,2)[6
DO CHKDISC6
QUIT
+9 SET APCDD=$$PROVCLS^XBFUNC1(P,"E")
End DoDot:2
+10 SET ^(APCDD)=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"AMB","PROV",APCDD)):^(APCDD)+1,1:1)
+11 QUIT
End DoDot:1
+12 QUIT
DEP ;tally dependent entries
+1 ;excludes LABS,MEDS,RADS,DENTALS
+2 NEW F,I,G,R,V,N
+3 SET F=9000010
FOR
SET F=$ORDER(^DIC(F))
IF F>9000010.99
QUIT
Begin DoDot:1
+4 IF F=9000010.04
QUIT
+5 IF F=9000010.09
QUIT
+6 IF F=9000010.14
QUIT
+7 IF F=9000010.22
QUIT
+8 SET N=$PIECE(^DIC(F,0),U)
+9 SET G=^DIC(F,0,"GL")
SET R=G_"""AD"",APCDVDFN,I)"
+10 SET I=0
FOR
SET I=$ORDER(@R)
IF I=""
QUIT
Begin DoDot:2
+11 SET ^(N)=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"DEP","FILE",N)):^(N)+1,1:1)
+12 SET ^("TOTAL")=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"DEP","TOTAL")):^("TOTAL")+1,1:1)
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 QUIT
+16 ;
OPER ;
+1 SET ^("TOTAL")=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"OPER",APCDO,"TOTAL")):^("TOTAL")+1,1:1)
+2 SET ^(APCDLOC)=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"OPER",APCDO,"LOC",APCDLOC)):^(APCDLOC)+1,1:1)
+3 SET ^(APCDTYPE)=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"OPER",APCDO,"TYPE",APCDTYPE)):^(APCDTYPE)+1,1:1)
+4 SET ^(APCDCAT)=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"OPER",APCDO,"CAT",APCDCAT)):^(APCDCAT)+1,1:1)
+5 QUIT
LOC ;
+1 SET ^("TOTAL")=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"LOC",APCDLOC,"TOTAL")):^("TOTAL")+1,1:1)
+2 SET ^(APCDCLN)=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"LOC",APCDLOC,"CLN",APCDCLN)):^(APCDCLN)+1,1:1)
+3 SET ^(APCDTYPE)=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"LOC",APCDLOC,"TYPE",APCDTYPE)):^(APCDTYPE)+1,1:1)
+4 SET ^(APCDCAT)=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"LOC",APCDLOC,"CAT",APCDCAT)):^(APCDCAT)+1,1:1)
+5 SET X=0
FOR
SET X=$ORDER(^AUPNVPRV("AD",APCDVDFN,X))
IF X'=+X
QUIT
Begin DoDot:1
+6 SET P=$PIECE(^AUPNVPRV(X,0),U)
Begin DoDot:2
+7 IF $PIECE(^DD(9000010.06,.01,0),U,2)[6
DO CHKDISC6
QUIT
+8 SET APCDD=$$PROVCLS^XBFUNC1(P,"E")
End DoDot:2
+9 SET ^(APCDD)=$SELECT($DATA(^XTMP("APCDFOS",APCDJ,APCDBT,"LOC",APCDLOC,"PROV",APCDD)):^(APCDD)+1,1:1)
+10 QUIT
End DoDot:1
+11 QUIT
CHKDISC6 ;
+1 NEW Y
+2 IF '$DATA(^DIC(6,P))
SET APCDD="??"
QUIT
+3 SET Y=$PIECE(^DIC(6,P,0),U,4)
+4 IF Y=""
SET APCDD="??"
QUIT
+5 IF '$DATA(^DIC(7,Y,9999999))
SET APCDD="??"
QUIT
+6 SET APCDD=$PIECE(^DIC(7,Y,0),U)
IF APCDD=""
SET APCDD="??"
QUIT
+7 QUIT
