IBCOC.m

IBCOC	;ALB/AAS - INACTIVE INS. COMPANIES WITH PATIENTS ; 04-NOV-93

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

	;

%	;

	; -- fileman print in inactive ins. companies

	W !!,"Print List of Inactive Insurance Companies still listed as Insuring Patients"

	W !!,"You will need a 132 column printer for this report!",!!

	S DIC="^DIC(36,",FLDS="[IB INACTIVE INS CO]",BY="[IB INACTIVE INS CO]",FR="?,?",TO="?,?"

	S DIS(0)="I $D(^DPT(""AB"",D0))"

	D EN1^DIP

	W !

	I $D(ZTQUEUED) S ZTREQ="@" Q

	D ^%ZISC

	K D,I,J,X,Y,IBCNT,DIC,FLDS,BY,TO,FR,DIS

	Q

	;

CNT(D0)	; -- count number of entries

	N X,Y S X=0

	G:'$G(D0) CNTQ

	S Y=0 F  S Y=$O(^DPT("AB",D0,Y)) Q:'Y  S X=X+1

CNTQ	Q X

IBCOC     ;ALB/AAS - INACTIVE INS. COMPANIES WITH PATIENTS ; 04-NOV-93

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 +2       ;

%         ;

 +1       ; -- fileman print in inactive ins. companies

 +2        WRITE !!,"Print List of Inactive Insurance Companies still listed as Insuring Patients"

 +3        WRITE !!,"You will need a 132 column printer for this report!",!!

 +4        SET DIC="^DIC(36,"

           SET FLDS="[IB INACTIVE INS CO]"

           SET BY="[IB INACTIVE INS CO]"

           SET FR="?,?"

           SET TO="?,?"

 +5        SET DIS(0)="I $D(^DPT(""AB"",D0))"

 +6        DO EN1^DIP

 +7        WRITE !

 +8        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

               QUIT 

 +9        DO ^%ZISC

 +10       KILL D,I,J,X,Y,IBCNT,DIC,FLDS,BY,TO,FR,DIS

 +11       QUIT 

 +12      ;

CNT(D0)   ; -- count number of entries

 +1        NEW X,Y

           SET X=0

 +2        IF '$GET(D0)

               GOTO CNTQ

 +3        SET Y=0

           FOR 

               SET Y=$ORDER(^DPT("AB",D0,Y))

               IF 'Y

                   QUIT 

               SET X=X+1

CNTQ       QUIT X