APCLT1 ; IHS/CMI/LAB - TOP T POVS ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;IHS/CMI/LAB - patch 4 Y2K
;
;IHS/TUCSON/LAB - added subroutine APWI for patch 1 to allow
;selection by appointment or walkin 05/01/97
;
W !!?20,"***** WAITING TIMES BY CLINIC AND PROVIDER *****",!!
W !,"This report will display minimum, maximum and mean waiting times by provider,",!,"and clinic. In order to have any data for this report, you must be entering",!,"the time the primary provider saw the patient.",!!
D EXIT
GETDATES ;
BD ;get beginning date
W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Visit Date" D ^DIR S:$D(DUOUT) DIRUT=1 K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G EXIT
S APCLBD=Y
ED ;get ending date
W ! S DIR(0)="D^"_APCLBD_":DT:EP",DIR("A")="Enter ending Visit Date" S Y=APCLBD D DD^%DT D ^DIR S:$D(DUOUT) DIRUT=1 K DIR S:$D(DUOUT) DIRUT=1
I Y="" G BD
I $D(DIRUT) G BD
S APCLED=Y
S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X
S Y=APCLBD D DD^%DT S APCLBDD=Y S Y=APCLED D DD^%DT S APCLEDD=Y
;
CLINIC ;
K APCLCLNT
W ! S DIR(0)="Y",DIR("A")="Tally Waiting Times for ALL clinics" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) BD
I Y=1 G APWI
CLINIC1 ;
S X="CLINIC",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G EXIT
D PEP^AMQQGTX0(+Y,"APCLCLNT(")
I '$D(APCLCLNT) G CLINIC
I $D(APCLCLNT("*")) K APCLCLNT
APWI ;ask appt or walk ins ;IHS/TUCSON/LAB - added this subroutine patch 1 05/01/97
S APCLAPWI=""
S DIR(0)="S^W:WALK-INS Only;A:APPOINTMENTS Only",DIR("A")="Do you wish to include",DIR("B")="A" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) CLINIC
S APCLAPWI=Y
;IHS/TUCSON/LAB - 05/01/97 of patch 1
ZIS ;
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G APWI
S XBRC="PROC^APCLT1",XBRP="^APCLT1P",XBNS="APCL",XBRX="EXIT^APCLT1"
D ^XBDBQUE
D EXIT
Q
EXIT ;
K APCLBD,APCLBDD,APCLSD,APCLED,APCLEDD,APCLCLNT,APCLAPPT,APCLBD,APCLBDD,APCLVT,APCLBTH,APCLCI,APCLCN,APCDT,APCLED,APCLEDD,APCLAPWI
K APCLJOB,APCLLENG,APCLLOCT,APCLODAT,APCLPG,APCLPP,APCLPPS,APCLQUIT,APCLSD,APCLSEC,APCLTOT,APCLTOTV,APCLVIEN,APCLVREC,APCLX
Q
PROC ;EP - called from xbdbque
S APCLTOTV=0
S (APCLBTH,APCLBT)=$H,APCLJOB=$J
K ^XTMP("APCLT1",APCLJOB,APCLBTH)
D XTMP^APCLOSUT("APCLT1","PCC CLINIC WAIT TIMES REPORT")
;
V ; Run by visit date
S APCLODAT=APCLSD_".9999" F S APCLODAT=$O(^AUPNVSIT("B",APCLODAT)) Q:APCLODAT=""!((APCLODAT\1)>APCLED) D V1
S C=0 F S C=$O(^XTMP("APCLT1",APCLJOB,APCLBTH,"MODE",C)) Q:C'=+C D
. S P=0 F S P=$O(^XTMP("APCLT1",APCLJOB,APCLBTH,"MODE",C,P)) Q:P'=+P D
.. S S=0 F S S=$O(^XTMP("APCLT1",APCLJOB,APCLBTH,"MODE",C,P,S)) Q:S'=+S S X=^XTMP("APCLT1",APCLJOB,APCLBTH,"MODE",C,P,S),^XTMP("APCLT1",APCLJOB,APCLBTH,"SET",C,P,9999999-X)=S
.. Q
. Q
;
END ;
S APCLET=$H
Q
V1 ;
S APCLVIEN="" F S APCLVIEN=$O(^AUPNVSIT("B",APCLODAT,APCLVIEN)) Q:APCLVIEN'=+APCLVIEN I $D(^AUPNVSIT(APCLVIEN,0)),$P(^(0),U,9),'$P(^(0),U,12) S APCLVREC=^(0) D PROC1
Q
PROC1 ;
Q:'$P(APCLVREC,U,8) ;no clinic
Q:$$DEMO^APCLUTL($P(APCLVREC,U,5),$G(APCLDEMO))
Q:'$D(^AUPNVPRV("AD",APCLVIEN)) ;no provider
S APCLPP=$$PRIMPROV^APCLV(APCLVIEN,"I")
Q:'APCLPP ;no primary provider returned
S APCLCLN=$P(APCLVREC,U,8)
I $D(APCLCLNT),'$D(APCLCLNT(APCLCLN)) Q
;IHS/TUCSON/LAB - added this next line for patch 1 05/01/97
I $D(APCLAPWI),$P(APCLVREC,U,16)'=APCLAPWI Q
S APCLAPPT=$P(APCLVREC,U,26)
S APCLCI=$P(APCLVREC,U)
S APCLPPS="",X=0 F S X=$O(^AUPNVPRV("AD",APCLVIEN,X)) Q:X'=+X I $P(^AUPNVPRV(X,0),U,4)="P",APCLPP=$P(^(0),U),$P($G(^AUPNVPRV(X,12)),U)]"" S APCLPPS=$P(^AUPNVPRV(X,12),U)
S $P(^(APCLPP),U)=$S($D(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP)):$P(^(APCLPP),U)+1,1:1)
S $P(^(APCLCLN),U)=$S($D(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN)):$P(^(APCLCLN),U)+1,1:1)
;Q:APCLAPPT="" ;cmi/lab 09/18/97 - commented this out added line below
I $G(APCLAPWI)="A" Q:$P(APCLAPPT,".",2)="" ;IHS/CMI/LAG - if report is run for appointments, do no use any visit whose appt time is blank
Q:APCLCI=""
Q:APCLPPS=""
Q:$P(APCLPPS,".",2)=""
;Q:APCLPPS<APCLAPPT ;*****what if see provider before appt time
;Q:APCLPPS<APCLCI ;******what if see provider before arrival time
;quit if don't have all the 3 pieces -- is this ok?
CALC ;calculate # mins waiting, use appt or arr, whichever is later
S APCLX=$S(APCLAPPT>APCLCI:APCLAPPT,1:APCLCI)
S APCLSEC=$S(APCLPPS<APCLX:0,1:$$FMDIFF^XLFDT(APCLPPS,APCLX,2))
;begin Y2K
;I APCLSEC>14400 S ^XTMP("APCLT1",APCLJOB,APCLBTH,"OUTLIERS",APCLVIEN)=$$FMTE^XLFDT($P(APCLVREC,U),"2E")_"^"_$P(^DPT($P(APCLVREC,U,5),0),U)_"^"_$$FMTE^XLFDT($P(APCLVREC,U,26),"2E")_"^"_$$FMTE^XLFDT(APCLPPS,"2E") Q ;Y2000
I APCLSEC>14400 S ^XTMP("APCLT1",APCLJOB,APCLBTH,"OUTLIERS",APCLVIEN)=$$FMTE^XLFDT($P(APCLVREC,U),"5D")_"^"_$P(^DPT($P(APCLVREC,U,5),0),U)_"^"_$$FMTE^XLFDT($P(APCLVREC,U,26),"5D")_"^"_$$FMTE^XLFDT(APCLPPS,"5D") Q ;Y2000
;I APCLSEC<-14400 S ^XTMP("APCLT1",APCLJOB,APCLBTH,"OUTLIERS",APCLVIEN)=$$FMTE^XLFDT($P(APCLVREC,U),"2E")_"^"_$P(^DPT($P(APCLVREC,U,5),0),U)_"^"_$$FMTE^XLFDT($P(APCLVREC,U,26),"2E")_"^"_$$FMTE^XLFDT(APCLPPS,"2E") Q ;Y2000
I APCLSEC<-14400 S ^XTMP("APCLT1",APCLJOB,APCLBTH,"OUTLIERS",APCLVIEN)=$$FMTE^XLFDT($P(APCLVREC,U),"5E")_"^"_$P(^DPT($P(APCLVREC,U,5),0),U)_"^"_$$FMTE^XLFDT($P(APCLVREC,U,26),"5E")_"^"_$$FMTE^XLFDT(APCLPPS,"5E") Q ;Y2000
;end Y2K
S $P(^(APCLPP),U,2)=$S($D(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP)):$P(^(APCLPP),U,2)+1,1:1)
S $P(^(APCLCLN),U,2)=$S($D(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN)):$P(^(APCLCLN),U,2)+1,1:1)
SET S $P(^(APCLPP),U,3)=$S($D(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP)):$P(^(APCLPP),U,3)+APCLSEC,1:APCLSEC)
S $P(^(APCLCLN),U,3)=$S($D(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN)):$P(^(APCLCLN),U,3)+APCLSEC,1:APCLSEC)
S:$P(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP),U,4)="" $P(^(APCLPP),U,4)=APCLSEC I $P(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP),U,4)>APCLSEC S $P(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP),U,4)=APCLSEC
S:$P(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,4)="" $P(^(APCLCLN),U,4)=APCLSEC I $P(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,4)>APCLSEC S $P(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,4)=APCLSEC
I $P(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP),U,5)<APCLSEC S $P(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP),U,5)=APCLSEC
I $P(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,5)<APCLSEC S $P(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,5)=APCLSEC
S X=$$FMDIFF^XLFDT(APCLCI,APCLAPPT,2)
I X<-300 S $P(^(APCLPP),U,6)=$S($D(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP)):$P(^(APCLPP),U,6)+1,1:1)
I X<-300 S $P(^(APCLCLN),U,6)=$S($D(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN)):$P(^(APCLCLN),U,6)+1,1:1)
I X>300 S $P(^(APCLPP),U,7)=$S($D(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP)):$P(^(APCLPP),U,7)+1,1:1)
I X>300 S $P(^(APCLCLN),U,7)=$S($D(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN)):$P(^(APCLCLN),U,7)+1,1:1)
S $P(^(APCLSEC),U)=$S($D(^XTMP("APCLT1",APCLJOB,APCLBTH,"MODEP",APCLCLN,APCLPP,APCLSEC)):$P(^(APCLSEC),U)+1,1:1)
S $P(^(APCLSEC),U)=$S($D(^XTMP("APCLT1",APCLJOB,APCLBTH,"MODEC",APCLCLN,APCLSEC)):$P(^(APCLSEC),U)+1,1:1)
Q
;
;
;
;
APCLT1 ; IHS/CMI/LAB - TOP T POVS ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;IHS/CMI/LAB - patch 4 Y2K
+3 ;
+4 ;IHS/TUCSON/LAB - added subroutine APWI for patch 1 to allow
+5 ;selection by appointment or walkin 05/01/97
+6 ;
+7 WRITE !!?20,"***** WAITING TIMES BY CLINIC AND PROVIDER *****",!!
+8 WRITE !,"This report will display minimum, maximum and mean waiting times by provider,",!,"and clinic. In order to have any data for this report, you must be entering",!,"the time the primary provider saw the patient.",!!
+9 DO EXIT
GETDATES ;
BD ;get beginning date
+1 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning Visit Date"
DO ^DIR
IF $DATA(DUOUT)
SET DIRUT=1
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO EXIT
+3 SET APCLBD=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="D^"_APCLBD_":DT:EP"
SET DIR("A")="Enter ending Visit Date"
SET Y=APCLBD
DO DD^%DT
DO ^DIR
IF $DATA(DUOUT)
SET DIRUT=1
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF Y=""
GOTO BD
+3 IF $DATA(DIRUT)
GOTO BD
+4 SET APCLED=Y
+5 SET X1=APCLBD
SET X2=-1
DO C^%DTC
SET APCLSD=X
+6 SET Y=APCLBD
DO DD^%DT
SET APCLBDD=Y
SET Y=APCLED
DO DD^%DT
SET APCLEDD=Y
+7 ;
CLINIC ;
+1 KILL APCLCLNT
+2 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Tally Waiting Times for ALL clinics"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
GOTO BD
+4 IF Y=1
GOTO APWI
CLINIC1 ;
+1 SET X="CLINIC"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
GOTO EXIT
+2 DO PEP^AMQQGTX0(+Y,"APCLCLNT(")
+3 IF '$DATA(APCLCLNT)
GOTO CLINIC
+4 IF $DATA(APCLCLNT("*"))
KILL APCLCLNT
APWI ;ask appt or walk ins ;IHS/TUCSON/LAB - added this subroutine patch 1 05/01/97
+1 SET APCLAPWI=""
+2 SET DIR(0)="S^W:WALK-INS Only;A:APPOINTMENTS Only"
SET DIR("A")="Do you wish to include"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO CLINIC
+4 SET APCLAPWI=Y
+5 ;IHS/TUCSON/LAB - 05/01/97 of patch 1
ZIS ;
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO APWI
+3 SET XBRC="PROC^APCLT1"
SET XBRP="^APCLT1P"
SET XBNS="APCL"
SET XBRX="EXIT^APCLT1"
+4 DO ^XBDBQUE
+5 DO EXIT
+6 QUIT
EXIT ;
+1 KILL APCLBD,APCLBDD,APCLSD,APCLED,APCLEDD,APCLCLNT,APCLAPPT,APCLBD,APCLBDD,APCLVT,APCLBTH,APCLCI,APCLCN,APCDT,APCLED,APCLEDD,APCLAPWI
+2 KILL APCLJOB,APCLLENG,APCLLOCT,APCLODAT,APCLPG,APCLPP,APCLPPS,APCLQUIT,APCLSD,APCLSEC,APCLTOT,APCLTOTV,APCLVIEN,APCLVREC,APCLX
+3 QUIT
PROC ;EP - called from xbdbque
+1 SET APCLTOTV=0
+2 SET (APCLBTH,APCLBT)=$HOROLOG
SET APCLJOB=$JOB
+3 KILL ^XTMP("APCLT1",APCLJOB,APCLBTH)
+4 DO XTMP^APCLOSUT("APCLT1","PCC CLINIC WAIT TIMES REPORT")
+5 ;
V ; Run by visit date
+1 SET APCLODAT=APCLSD_".9999"
FOR
SET APCLODAT=$ORDER(^AUPNVSIT("B",APCLODAT))
IF APCLODAT=""!((APCLODAT\1)>APCLED)
QUIT
DO V1
+2 SET C=0
FOR
SET C=$ORDER(^XTMP("APCLT1",APCLJOB,APCLBTH,"MODE",C))
IF C'=+C
QUIT
Begin DoDot:1
+3 SET P=0
FOR
SET P=$ORDER(^XTMP("APCLT1",APCLJOB,APCLBTH,"MODE",C,P))
IF P'=+P
QUIT
Begin DoDot:2
+4 SET S=0
FOR
SET S=$ORDER(^XTMP("APCLT1",APCLJOB,APCLBTH,"MODE",C,P,S))
IF S'=+S
QUIT
SET X=^XTMP("APCLT1",APCLJOB,APCLBTH,"MODE",C,P,S)
SET ^XTMP("APCLT1",APCLJOB,APCLBTH,"SET",C,P,9999999-X)=S
+5 QUIT
End DoDot:2
+6 QUIT
End DoDot:1
+7 ;
END ;
+1 SET APCLET=$HOROLOG
+2 QUIT
V1 ;
+1 SET APCLVIEN=""
FOR
SET APCLVIEN=$ORDER(^AUPNVSIT("B",APCLODAT,APCLVIEN))
IF APCLVIEN'=+APCLVIEN
QUIT
IF $DATA(^AUPNVSIT(APCLVIEN,0))
IF $PIECE(^(0),U,9)
IF '$PIECE(^(0),U,12)
SET APCLVREC=^(0)
DO PROC1
+2 QUIT
PROC1 ;
+1 ;no clinic
IF '$PIECE(APCLVREC,U,8)
QUIT
+2 IF $$DEMO^APCLUTL($PIECE(APCLVREC,U,5),$GET(APCLDEMO))
QUIT
+3 ;no provider
IF '$DATA(^AUPNVPRV("AD",APCLVIEN))
QUIT
+4 SET APCLPP=$$PRIMPROV^APCLV(APCLVIEN,"I")
+5 ;no primary provider returned
IF 'APCLPP
QUIT
+6 SET APCLCLN=$PIECE(APCLVREC,U,8)
+7 IF $DATA(APCLCLNT)
IF '$DATA(APCLCLNT(APCLCLN))
QUIT
+8 ;IHS/TUCSON/LAB - added this next line for patch 1 05/01/97
+9 IF $DATA(APCLAPWI)
IF $PIECE(APCLVREC,U,16)'=APCLAPWI
QUIT
+10 SET APCLAPPT=$PIECE(APCLVREC,U,26)
+11 SET APCLCI=$PIECE(APCLVREC,U)
+12 SET APCLPPS=""
SET X=0
FOR
SET X=$ORDER(^AUPNVPRV("AD",APCLVIEN,X))
IF X'=+X
QUIT
IF $PIECE(^AUPNVPRV(X,0),U,4)="P"
IF APCLPP=$PIECE(^(0),U)
IF $PIECE($GET(^AUPNVPRV(X,12)),U)]""
SET APCLPPS=$PIECE(^AUPNVPRV(X,12),U)
+13 SET $PIECE(^(APCLPP),U)=$SELECT($DATA(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP)):$PIECE(^(APCLPP),U)+1,1:1)
+14 SET $PIECE(^(APCLCLN),U)=$SELECT($DATA(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN)):$PIECE(^(APCLCLN),U)+1,1:1)
+15 ;Q:APCLAPPT="" ;cmi/lab 09/18/97 - commented this out added line below
+16 ;IHS/CMI/LAG - if report is run for appointments, do no use any visit whose appt time is blank
IF $GET(APCLAPWI)="A"
IF $PIECE(APCLAPPT,".",2)=""
QUIT
+17 IF APCLCI=""
QUIT
+18 IF APCLPPS=""
QUIT
+19 IF $PIECE(APCLPPS,".",2)=""
QUIT
+20 ;Q:APCLPPS<APCLAPPT ;*****what if see provider before appt time
+21 ;Q:APCLPPS<APCLCI ;******what if see provider before arrival time
+22 ;quit if don't have all the 3 pieces -- is this ok?
CALC ;calculate # mins waiting, use appt or arr, whichever is later
+1 SET APCLX=$SELECT(APCLAPPT>APCLCI:APCLAPPT,1:APCLCI)
+2 SET APCLSEC=$SELECT(APCLPPS<APCLX:0,1:$$FMDIFF^XLFDT(APCLPPS,APCLX,2))
+3 ;begin Y2K
+4 ;I APCLSEC>14400 S ^XTMP("APCLT1",APCLJOB,APCLBTH,"OUTLIERS",APCLVIEN)=$$FMTE^XLFDT($P(APCLVREC,U),"2E")_"^"_$P(^DPT($P(APCLVREC,U,5),0),U)_"^"_$$FMTE^XLFDT($P(APCLVREC,U,26),"2E")_"^"_$$FMTE^XLFDT(APCLPPS,"2E") Q ;Y2000
+5 ;Y2000
IF APCLSEC>14400
SET ^XTMP("APCLT1",APCLJOB,APCLBTH,"OUTLIERS",APCLVIEN)=$$FMTE^XLFDT($PIECE(APCLVREC,U),"5D")_"^"_$PIECE(^DPT($PIECE(APCLVREC,U,5),0),U)_"^"_$$FMTE^XLFDT($PIECE(APCLVREC,U,26),"5D")_"^"_$$FMTE^XLFDT(APCLPPS,"5D")
QUIT
+6 ;I APCLSEC<-14400 S ^XTMP("APCLT1",APCLJOB,APCLBTH,"OUTLIERS",APCLVIEN)=$$FMTE^XLFDT($P(APCLVREC,U),"2E")_"^"_$P(^DPT($P(APCLVREC,U,5),0),U)_"^"_$$FMTE^XLFDT($P(APCLVREC,U,26),"2E")_"^"_$$FMTE^XLFDT(APCLPPS,"2E") Q ;Y2000
+7 ;Y2000
IF APCLSEC<-14400
SET ^XTMP("APCLT1",APCLJOB,APCLBTH,"OUTLIERS",APCLVIEN)=$$FMTE^XLFDT($PIECE(APCLVREC,U),"5E")_"^"_$PIECE(^DPT($PIECE(APCLVREC,U,5),0),U)_"^"_$$FMTE^XLFDT($PIECE(APCLVREC,U,26),"5E")_"^"_$$FMTE^XLFDT(APCLPPS,"5E")
QUIT
+8 ;end Y2K
+9 SET $PIECE(^(APCLPP),U,2)=$SELECT($DATA(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP)):$PIECE(^(APCLPP),U,2)+1,1:1)
+10 SET $PIECE(^(APCLCLN),U,2)=$SELECT($DATA(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN)):$PIECE(^(APCLCLN),U,2)+1,1:1)
SET SET $PIECE(^(APCLPP),U,3)=$SELECT($DATA(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP)):$PIECE(^(APCLPP),U,3)+APCLSEC,1:APCLSEC)
+1 SET $PIECE(^(APCLCLN),U,3)=$SELECT($DATA(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN)):$PIECE(^(APCLCLN),U,3)+APCLSEC,1:APCLSEC)
+2 IF $PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP),U,4)=""
SET $PIECE(^(APCLPP),U,4)=APCLSEC
IF $PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP),U,4)>APCLSEC
SET $PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP),U,4)=APCLSEC
+3 IF $PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,4)=""
SET $PIECE(^(APCLCLN),U,4)=APCLSEC
IF $PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,4)>APCLSEC
SET $PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,4)=APCLSEC
+4 IF $PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP),U,5)<APCLSEC
SET $PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP),U,5)=APCLSEC
+5 IF $PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,5)<APCLSEC
SET $PIECE(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN),U,5)=APCLSEC
+6 SET X=$$FMDIFF^XLFDT(APCLCI,APCLAPPT,2)
+7 IF X<-300
SET $PIECE(^(APCLPP),U,6)=$SELECT($DATA(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP)):$PIECE(^(APCLPP),U,6)+1,1:1)
+8 IF X<-300
SET $PIECE(^(APCLCLN),U,6)=$SELECT($DATA(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN)):$PIECE(^(APCLCLN),U,6)+1,1:1)
+9 IF X>300
SET $PIECE(^(APCLPP),U,7)=$SELECT($DATA(^XTMP("APCLT1",APCLJOB,APCLBTH,"IND",APCLCLN,APCLPP)):$PIECE(^(APCLPP),U,7)+1,1:1)
+10 IF X>300
SET $PIECE(^(APCLCLN),U,7)=$SELECT($DATA(^XTMP("APCLT1",APCLJOB,APCLBTH,"TOTAL",APCLCLN)):$PIECE(^(APCLCLN),U,7)+1,1:1)
+11 SET $PIECE(^(APCLSEC),U)=$SELECT($DATA(^XTMP("APCLT1",APCLJOB,APCLBTH,"MODEP",APCLCLN,APCLPP,APCLSEC)):$PIECE(^(APCLSEC),U)+1,1:1)
+12 SET $PIECE(^(APCLSEC),U)=$SELECT($DATA(^XTMP("APCLT1",APCLJOB,APCLBTH,"MODEC",APCLCLN,APCLSEC)):$PIECE(^(APCLSEC),U)+1,1:1)
+13 QUIT
+14 ;
+15 ;
+16 ;
+17 ;
