| [613] | 1 | IBDFFV2 ;ALB/CMR - AICS FORM VALIDATION ; NOV 27,1995
 | 
|---|
 | 2 |  ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
 | 
|---|
 | 3 |  ;
 | 
|---|
 | 4 |  ; -- entry point from IBDFFV
 | 
|---|
 | 5 |  ; -- called to print out data validation
 | 
|---|
 | 6 |  ;
 | 
|---|
 | 7 |  Q:'$D(^TMP($J,"IBFV"))
 | 
|---|
 | 8 |  W:IOST["C-" @IOF
 | 
|---|
 | 9 |  N SORT,DOT
 | 
|---|
 | 10 |  S DOT=".",$P(DOT,".",35)=".",SORT=$O(^TMP($J,"IBFV","")) Q:SORT']""
 | 
|---|
 | 11 |  ; -- if sorted by form, gather forms to print
 | 
|---|
 | 12 |  I SORT="F" N FORM,TYPE,FRM,WRITE D  Q
 | 
|---|
 | 13 |  .S TYPE=$P($T(TYPE+1),";;",2)
 | 
|---|
 | 14 |  .S FORM="" F  S FORM=$O(^TMP($J,"IBFV",SORT,FORM)) Q:FORM']""!($G(IBDFOUT))  S FRM=0 F  S FRM=$O(^TMP($J,"IBFV",SORT,FORM,FRM)) Q:'FRM!($G(IBDFOUT))  D PRINT^IBDFFV3(FRM,FORM) I '$G(WRITE) D
 | 
|---|
 | 15 |  ..S ^TMP($J,"IBDF","UC",SORT,FORM)=""
 | 
|---|
 | 16 |  ; -- if sorted by clinic, gather clinics
 | 
|---|
 | 17 |  I SORT="C" N CLIN,SETUP,CL,DG D  Q
 | 
|---|
 | 18 |  .S CLIN="" F  S CLIN=$O(^TMP($J,"IBFV",SORT,CLIN)) Q:CLIN']""!($G(IBDFOUT))  S CL="CLINIC:  .."_DOT_"  "_CLIN,DG="",SETUP=0 F  S SETUP=$O(^TMP($J,"IBFV",SORT,CLIN,SETUP)) Q:'SETUP!($G(IBDFOUT))  D CLIN
 | 
|---|
 | 19 |  ; -- if sorted by group, gather groups or divisions and clinics
 | 
|---|
 | 20 |  I SORT="G"!(SORT="D") N HEADER,CLIN,SETUP,CL,DG D  Q
 | 
|---|
 | 21 |  .S HEADER="" F  S HEADER=$O(^TMP($J,"IBFV",SORT,HEADER)) Q:HEADER']""!($G(IBDFOUT))  D
 | 
|---|
 | 22 |  ..S CLIN="" F  S CLIN=$O(^TMP($J,"IBFV",SORT,HEADER,CLIN)) Q:CLIN']""!($G(IBDFOUT))  D
 | 
|---|
 | 23 |  ...S DG=$S(SORT="G":"GROUP:  ...",SORT="D":"DIVISION:  ",1:"")
 | 
|---|
 | 24 |  ...I DG]"" S DG=DG_DOT_"  "_HEADER
 | 
|---|
 | 25 |  ...S CL="CLINIC:  .."_DOT_"  "_CLIN
 | 
|---|
 | 26 |  ...S SETUP=0 F  S SETUP=$O(^TMP($J,"IBFV",SORT,HEADER,CLIN,SETUP)) Q:'SETUP!($G(IBDFOUT))  D CLIN
 | 
|---|
 | 27 |  Q
 | 
|---|
 | 28 | CLIN ; -- gather forms for clinics
 | 
|---|
 | 29 |  N NODE,TYPE,FRM,CHECK,WRITE,NAME
 | 
|---|
 | 30 |  S NODE=$G(^SD(409.95,SETUP,0))
 | 
|---|
 | 31 |  F I=2:1:9 S FRM=$P(NODE,U,I) I FRM D PRINT^IBDFFV3(FRM,.NAME,I,CL,DG) Q:$G(IBDFOUT)  I '$D(WRITE) D
 | 
|---|
 | 32 |  .I SORT="C" S ^TMP($J,"IBDF","UC",SORT,CLIN,NAME)="" Q
 | 
|---|
 | 33 |  .S ^TMP($J,"IBDF","UC",SORT,HEADER,CLIN,NAME)=""
 | 
|---|
 | 34 |  Q
 | 
|---|