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