- IBDFFV2 ;ALB/CMR - AICS FORM VALIDATION ; NOV 27,1995
- ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- ;
- ; -- entry point from IBDFFV
- ; -- called to print out data validation
- ;
- Q:'$D(^TMP($J,"IBFV"))
- W:IOST["C-" @IOF
- N SORT,DOT
- S DOT=".",$P(DOT,".",35)=".",SORT=$O(^TMP($J,"IBFV","")) Q:SORT']""
- ; -- if sorted by form, gather forms to print
- I SORT="F" N FORM,TYPE,FRM,WRITE D Q
- .S TYPE=$P($T(TYPE+1),";;",2)
- .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
- ..S ^TMP($J,"IBDF","UC",SORT,FORM)=""
- ; -- if sorted by clinic, gather clinics
- I SORT="C" N CLIN,SETUP,CL,DG D Q
- .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
- ; -- if sorted by group, gather groups or divisions and clinics
- I SORT="G"!(SORT="D") N HEADER,CLIN,SETUP,CL,DG D Q
- .S HEADER="" F S HEADER=$O(^TMP($J,"IBFV",SORT,HEADER)) Q:HEADER']""!($G(IBDFOUT)) D
- ..S CLIN="" F S CLIN=$O(^TMP($J,"IBFV",SORT,HEADER,CLIN)) Q:CLIN']""!($G(IBDFOUT)) D
- ...S DG=$S(SORT="G":"GROUP: ...",SORT="D":"DIVISION: ",1:"")
- ...I DG]"" S DG=DG_DOT_" "_HEADER
- ...S CL="CLINIC: .."_DOT_" "_CLIN
- ...S SETUP=0 F S SETUP=$O(^TMP($J,"IBFV",SORT,HEADER,CLIN,SETUP)) Q:'SETUP!($G(IBDFOUT)) D CLIN
- Q
- CLIN ; -- gather forms for clinics
- N NODE,TYPE,FRM,CHECK,WRITE,NAME
- S NODE=$G(^SD(409.95,SETUP,0))
- 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
- .I SORT="C" S ^TMP($J,"IBDF","UC",SORT,CLIN,NAME)="" Q
- .S ^TMP($J,"IBDF","UC",SORT,HEADER,CLIN,NAME)=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFFV2 1814 printed Mar 13, 2025@21:57:42 Page 2
- IBDFFV2 ;ALB/CMR - AICS FORM VALIDATION ; NOV 27,1995
- +1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- +2 ;
- +3 ; -- entry point from IBDFFV
- +4 ; -- called to print out data validation
- +5 ;
- +6 if '$DATA(^TMP($JOB,"IBFV"))
- QUIT
- +7 if IOST["C-"
- WRITE @IOF
- +8 NEW SORT,DOT
- +9 SET DOT="."
- SET $PIECE(DOT,".",35)="."
- SET SORT=$ORDER(^TMP($JOB,"IBFV",""))
- if SORT']""
- QUIT
- +10 ; -- if sorted by form, gather forms to print
- +11 IF SORT="F"
- NEW FORM,TYPE,FRM,WRITE
- Begin DoDot:1
- +12 SET TYPE=$PIECE($TEXT(TYPE+1),";;",2)
- +13 SET FORM=""
- FOR
- SET FORM=$ORDER(^TMP($JOB,"IBFV",SORT,FORM))
- if FORM']""!($GET(IBDFOUT))
- QUIT
- SET FRM=0
- FOR
- SET FRM=$ORDER(^TMP($JOB,"IBFV",SORT,FORM,FRM))
- if 'FRM!($GET(IBDFOUT))
- QUIT
- DO PRINT^IBDFFV3(FRM,FORM)
- IF '$GET(WRITE)
- Begin DoDot:2
- +14 SET ^TMP($JOB,"IBDF","UC",SORT,FORM)=""
- End DoDot:2
- End DoDot:1
- QUIT
- +15 ; -- if sorted by clinic, gather clinics
- +16 IF SORT="C"
- NEW CLIN,SETUP,CL,DG
- Begin DoDot:1
- +17 SET CLIN=""
- FOR
- SET CLIN=$ORDER(^TMP($JOB,"IBFV",SORT,CLIN))
- if CLIN']""!($GET(IBDFOUT))
- QUIT
- SET CL="CLINIC: .."_DOT_" "_CLIN
- SET DG=""
- SET SETUP=0
- FOR
- SET SETUP=$ORDER(^TMP($JOB,"IBFV",SORT,CLIN,SETUP))
- if 'SETUP!($GET(IBDFOUT))
- QUIT
- DO CLIN
- End DoDot:1
- QUIT
- +18 ; -- if sorted by group, gather groups or divisions and clinics
- +19 IF SORT="G"!(SORT="D")
- NEW HEADER,CLIN,SETUP,CL,DG
- Begin DoDot:1
- +20 SET HEADER=""
- FOR
- SET HEADER=$ORDER(^TMP($JOB,"IBFV",SORT,HEADER))
- if HEADER']""!($GET(IBDFOUT))
- QUIT
- Begin DoDot:2
- +21 SET CLIN=""
- FOR
- SET CLIN=$ORDER(^TMP($JOB,"IBFV",SORT,HEADER,CLIN))
- if CLIN']""!($GET(IBDFOUT))
- QUIT
- Begin DoDot:3
- +22 SET DG=$SELECT(SORT="G":"GROUP: ...",SORT="D":"DIVISION: ",1:"")
- +23 IF DG]""
- SET DG=DG_DOT_" "_HEADER
- +24 SET CL="CLINIC: .."_DOT_" "_CLIN
- +25 SET SETUP=0
- FOR
- SET SETUP=$ORDER(^TMP($JOB,"IBFV",SORT,HEADER,CLIN,SETUP))
- if 'SETUP!($GET(IBDFOUT))
- QUIT
- DO CLIN
- End DoDot:3
- End DoDot:2
- End DoDot:1
- QUIT
- +26 QUIT
- CLIN ; -- gather forms for clinics
- +1 NEW NODE,TYPE,FRM,CHECK,WRITE,NAME
- +2 SET NODE=$GET(^SD(409.95,SETUP,0))
- +3 FOR I=2:1:9
- SET FRM=$PIECE(NODE,U,I)
- IF FRM
- DO PRINT^IBDFFV3(FRM,.NAME,I,CL,DG)
- if $GET(IBDFOUT)
- QUIT
- IF '$DATA(WRITE)
- Begin DoDot:1
- +4 IF SORT="C"
- SET ^TMP($JOB,"IBDF","UC",SORT,CLIN,NAME)=""
- QUIT
- +5 SET ^TMP($JOB,"IBDF","UC",SORT,HEADER,CLIN,NAME)=""
- End DoDot:1
- +6 QUIT
