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)
Q
;
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF1B2 1372 printed Oct 16, 2024@18:51:52 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
