- 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
