- IBYDPT ;ALB/TMP - PATCH IB*2*44 POST-INITIALIZATION ; 14-JUL-95
- ;;Version 2.0 ; INTEGRATED BILLING ;**44**; 21-MAR-94
- ;
- EN D APD3
- Q
- APD3 ; Sets up 'APD3' xref on field 10 of file 399 (AUTHORIZATION DATE)
- N CT,DA,X,H1,H2 S H1=$H
- I $D(^DGCR(399,"APD3")) W !!,"APD3 cross reference already exists - not rebuilt",!!,"Done.",! Q
- W !!,">>> Building the 'APD3' cross-reference for file #399 ..."
- W !," (I'll write a dot for every 500 entries processed)",!
- S (CT,DA)=0 F S DA=$O(^DGCR(399,DA)) Q:'DA S CT=CT+1,X=$E($P($G(^DGCR(399,DA,"S")),U,10),1,30) W:'(CT#500) "." I X'="" S ^DGCR(399,"APD3",X,DA)=""
- W !!,"Done."
- ;
- ;TEST SITES ONLY
- D S H2=$H
- W !!,"Count: ",CT
- W !,"Begin: ",$$HTE^XLFDT(H1)
- W !,"End: ",$$HTE^XLFDT(H2)
- W !!,CT," entries processed in ",$$HDIFF^XLFDT(H2,H1,3),"."
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBYDPT 819 printed Feb 19, 2025@00:02:11 Page 2
- IBYDPT ;ALB/TMP - PATCH IB*2*44 POST-INITIALIZATION ; 14-JUL-95
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;**44**; 21-MAR-94
- +2 ;
- EN DO APD3
- +1 QUIT
- APD3 ; Sets up 'APD3' xref on field 10 of file 399 (AUTHORIZATION DATE)
- +1 NEW CT,DA,X,H1,H2
- SET H1=$HOROLOG
- +2 IF $DATA(^DGCR(399,"APD3"))
- WRITE !!,"APD3 cross reference already exists - not rebuilt",!!,"Done.",!
- QUIT
- +3 WRITE !!,">>> Building the 'APD3' cross-reference for file #399 ..."
- +4 WRITE !," (I'll write a dot for every 500 entries processed)",!
- +5 SET (CT,DA)=0
- FOR
- SET DA=$ORDER(^DGCR(399,DA))
- if 'DA
- QUIT
- SET CT=CT+1
- SET X=$EXTRACT($PIECE($GET(^DGCR(399,DA,"S")),U,10),1,30)
- if '(CT#500)
- WRITE "."
- IF X'=""
- SET ^DGCR(399,"APD3",X,DA)=""
- +6 WRITE !!,"Done."
- +7 ;
- +8 ;TEST SITES ONLY
- D SET H2=$HOROLOG
- +1 WRITE !!,"Count: ",CT
- +2 WRITE !,"Begin: ",$$HTE^XLFDT(H1)
- +3 WRITE !,"End: ",$$HTE^XLFDT(H2)
- +4 WRITE !!,CT," entries processed in ",$$HDIFF^XLFDT(H2,H1,3),"."
- +5 QUIT
