Routine: IBDF1B2

IBDF1B2 ;ALB/CJM - ENCOUNTER FORM PRINT (IBDF1B1 continued - user options for printing); 3/1/93

 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

PRNTFRMS ;print encounter form(s) for an appointment

 N FORMS,IBFORM,IBF

 ;FORMS - list of forms to print for patient

 ;IBF - a counter used to parse FORMS

 S FORMS=$$FORMS(IBCLINIC,DFN,IBAPPT)

 F IBF=1:1 S IBFORM=$P(FORMS,"^",IBF) Q:'IBFORM  D DRWFORM^IBDF2A(IBFORM,1,.IBDEVICE)

FORMS(CLINIC,DFN,IBAPPT) ;returns a list of forms that should be printed for this patient in this clinic and this appt.

 N FORMS,SETUP,TYPE

 S FORMS=""

 S SETUP=$O(^SD(409.95,"B",+CLINIC,0)),SETUP=$G(^SD(409.95,+SETUP,0))

 S:$P(SETUP,"^",2) FORMS=$P(SETUP,"^",2)_"^"

 S:$P(SETUP,"^",6) FORMS=FORMS_$P(SETUP,"^",6)_"^"

 S:$P(SETUP,"^",8) FORMS=FORMS_$P(SETUP,"^",8)_"^"

 S:$P(SETUP,"^",9) FORMS=FORMS_$P(SETUP,"^",9)_"^"

 I $P(SETUP,"^",3)!$P(SETUP,"^",4) D

 .D TYPE

 .I TYPE="NEW",$P(SETUP,"^",4) S FORMS=FORMS_$P(SETUP,"^",4)_"^"

 .I TYPE="OLD",$P(SETUP,"^",3) S FORMS=FORMS_$P(SETUP,"^",3)_"^"

 Q FORMS

TYPE ;determine if patient is NEW or OLD at clinic - quick and dirty

 N APPT,NODE

 S TYPE="NEW"

 S APPT=DT-10000 F  S APPT=$O(^DPT(DFN,"S",APPT)) Q:('APPT)!(APPT'<IBAPPT)  S NODE=$G(^DPT(DFN,"S",APPT,0)) I +NODE=CLINIC,(($P(NODE,"^",2)="I")!($P(NODE,"^",2)="NT")!($P(NODE,"^",2)="")) S TYPE="OLD" Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF1B2   1372     printed  Feb 19, 2025@00:17:32                                                                                                                                                                                                     Page 2

IBDF1B2   ;ALB/CJM - ENCOUNTER FORM PRINT (IBDF1B1 continued - user options for printing); 3/1/93

 +1       ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

 +2       ;

PRNTFRMS  ;print encounter form(s) for an appointment

 +1        NEW FORMS,IBFORM,IBF

 +2       ;FORMS - list of forms to print for patient

 +3       ;IBF - a counter used to parse FORMS

 +4        SET FORMS=$$FORMS(IBCLINIC,DFN,IBAPPT)

 +5        FOR IBF=1:1

               SET IBFORM=$PIECE(FORMS,"^",IBF)

               if 'IBFORM

                   QUIT

               DO DRWFORM^IBDF2A(IBFORM,1,.IBDEVICE)

 +6        QUIT

 +7       ;

FORMS(CLINIC,DFN,IBAPPT) ;returns a list of forms that should be printed for this patient in this clinic and this appt.

 +1        NEW FORMS,SETUP,TYPE

 +2        SET FORMS=""

 +3        SET SETUP=$ORDER(^SD(409.95,"B",+CLINIC,0))

           SET SETUP=$GET(^SD(409.95,+SETUP,0))

 +4        if $PIECE(SETUP,"^",2)

               SET FORMS=$PIECE(SETUP,"^",2)_"^"

 +5        if $PIECE(SETUP,"^",6)

               SET FORMS=FORMS_$PIECE(SETUP,"^",6)_"^"

 +6        if $PIECE(SETUP,"^",8)

               SET FORMS=FORMS_$PIECE(SETUP,"^",8)_"^"

 +7        if $PIECE(SETUP,"^",9)

               SET FORMS=FORMS_$PIECE(SETUP,"^",9)_"^"

 +8        IF $PIECE(SETUP,"^",3)!$PIECE(SETUP,"^",4)

               Begin DoDot:1

 +9                DO TYPE

 +10               IF TYPE="NEW"

                       IF $PIECE(SETUP,"^",4)

                           SET FORMS=FORMS_$PIECE(SETUP,"^",4)_"^"

 +11               IF TYPE="OLD"

                       IF $PIECE(SETUP,"^",3)

                           SET FORMS=FORMS_$PIECE(SETUP,"^",3)_"^"

               End DoDot:1

 +12       QUIT FORMS

TYPE      ;determine if patient is NEW or OLD at clinic - quick and dirty

 +1        NEW APPT,NODE

 +2        SET TYPE="NEW"

 +3        SET APPT=DT-10000

FOR

               SET APPT=$ORDER(^DPT(DFN,"S",APPT))

               if ('APPT)!(APPT'<IBAPPT)

                   QUIT

               SET NODE=$GET(^DPT(DFN,"S",APPT,0))

               IF +NODE=CLINIC

                   IF (($PIECE(NODE,"^",2)="I")!($PIECE(NODE,"^",2)="NT")!($PIECE(NODE,"^",2)=""))

                       SET TYPE="OLD"

                       QUIT

 +4        QUIT

IBDF1B2.m