IBDE4 ;ALB/AAS - PUT FORMS AND BLOCKS INTO IMPORT/EXPORT UTILTIY ;AUG 12,1993
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
ADD ; -- add forms to the import exort utility
N FORM,NEWFORM,FORMNM,CNT,CNT1,ARY,NAME,X,Y,NEWBLOCK,A,EXCLUDE,BLK
F CNT=1:1 S FORMNM=$P($T(FORMS+CNT),";;",2,99) Q:FORMNM="" D
.S FORM=$O(^IBE(357,"B",$E(FORMNM,1,30),0))
.Q:$O(^IBE(358,"B",$E(FORMNM,1,30),0))
.W !,"Moving Form '"_FORMNM_"' to import export utility"
.S NEWFORM=$$COPYFORM^IBDFU2C(FORM,357,358,"",1)
;
; -- add all blocks for a form
F CNT=1:1 S FORMNM=$P($T(BLOCKS+CNT),";;",2,99) Q:FORMNM="" D
.S FORM=$O(^IBE(357,"B",$E(FORMNM,1,30),0))
.Q:$O(^IBE(358,"B",$E(FORMNM,1,30),0))
.S ARY="A",EXCLUDE="" K A
.S CNT1=$$FINDALL^IBDFU8
.S NAME="" F S NAME=$O(A("NAME",NAME)) Q:NAME="" S BLK=0 F S BLK=$O(A("NAME",NAME,BLK)) Q:'BLK D
..W !,"Moving Block '"_NAME_"' from form '"_FORMNM_"' to utility"
..;Q:$O(^IBE(357.1,"B",NAME,0)) ;quit if same block from same form
..S NEWBLOCK=$$COPYBLK^IBDFU2(BLK,"",357.1,358.1,"","",1)
Q
;
AUTOINS ; -- auto install tool kit into production
N FORM,NEWFORM,FORMNM,CNT,CNT1,ARY,NAME,X,Y,NEWBLOCK,A,EXCLUDE,BLK,CNTF,CNTB
W !!,">>> Now Attempting to automatically update Tool Kit forms and Tool Kit Blocks."
S (CNTB,CNTF)=0
;
; -- add all tool kit blocks
S FORMNM="TOOL KIT"
I '$O(^IBE(357,"B",FORMNM,0)) G FRM
S ORD="" F S ORD=$O(^IBE(358.1,"D",ORD)) Q:ORD="" S BLK=0 F S BLK=$O(^IBE(358.1,"D",ORD,BLK)) Q:'BLK D
.S NAME=$P($G(^IBE(358.1,+BLK,0)),"^")
.Q:$P($G(^IBE(358.1,BLK,0)),"^",14)'=1 ;not toolkit
.Q:$O(^IBE(357.1,"B",NAME,0)) ;already installed
.W !," Moving Block '"_$P($G(^IBE(358.1,+BLK,0)),"^")_"' from import/export to Tool Kit"
.N IBTKBLK S IBTKBLK=1
.S NEWBLOCK=$$COPYBLK^IBDFU2(BLK,$$TKFORM^IBDFU2C,358.1,357.1,"","",$$TKORDER^IBDF13),CNTB=CNTB+1
.D:$G(NEWBLOCK) DLTBLK^IBDFU3(BLK,"",358.1)
;
FRM ; -- Add tool kit forms
F CNT=1:1 S FORMNM=$P($T(FORMS+CNT),";;",2,99) Q:FORMNM="" D
.S FORM=$O(^IBE(358,"B",$E(FORMNM,1,30),0))
.Q:$O(^IBE(357,"B",$E(FORMNM,1,30),0))
.W !," Moving Form '"_FORMNM_"' from import export utility to AICS"
.S NEWFORM=$$COPYFORM^IBDFU2C(FORM,358,357,"",1),CNTF=CNTF+1
;
I CNTF=0,CNTB=0 W !!,">>> Tool Kit Forms and Blocks are already installed." Q
W !!,">>> Tool Kit Forms sent (4): ",$J(CNTF,3)_" installed"
W !,">>> Tool Kit Blocks sent (28): ",$J(CNTB,3)_" installed"
Q
;
FORMS ;;
;;DEFAULTS
;;
;;
;;AMBULATORY SURGERY SAMPLE V2.1
;;EMERGENCY SERVICES SAMPLE V2.1
;;PRIMARY CARE SAMPLE V2.1
;;
BLOCKS ;;
;;TOOL KIT
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDE4 2627 printed Apr 09, 2024@21:38:02 Page 2
IBDE4 ;ALB/AAS - PUT FORMS AND BLOCKS INTO IMPORT/EXPORT UTILTIY ;AUG 12,1993
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
ADD ; -- add forms to the import exort utility
+1 NEW FORM,NEWFORM,FORMNM,CNT,CNT1,ARY,NAME,X,Y,NEWBLOCK,A,EXCLUDE,BLK
+2 FOR CNT=1:1
SET FORMNM=$PIECE($TEXT(FORMS+CNT),";;",2,99)
if FORMNM=""
QUIT
Begin DoDot:1
+3 SET FORM=$ORDER(^IBE(357,"B",$EXTRACT(FORMNM,1,30),0))
+4 if $ORDER(^IBE(358,"B",$EXTRACT(FORMNM,1,30),0))
QUIT
+5 WRITE !,"Moving Form '"_FORMNM_"' to import export utility"
+6 SET NEWFORM=$$COPYFORM^IBDFU2C(FORM,357,358,"",1)
End DoDot:1
+7 ;
+8 ; -- add all blocks for a form
+9 FOR CNT=1:1
SET FORMNM=$PIECE($TEXT(BLOCKS+CNT),";;",2,99)
if FORMNM=""
QUIT
Begin DoDot:1
+10 SET FORM=$ORDER(^IBE(357,"B",$EXTRACT(FORMNM,1,30),0))
+11 if $ORDER(^IBE(358,"B",$EXTRACT(FORMNM,1,30),0))
QUIT
+12 SET ARY="A"
SET EXCLUDE=""
KILL A
+13 SET CNT1=$$FINDALL^IBDFU8
+14 SET NAME=""
FOR
SET NAME=$ORDER(A("NAME",NAME))
if NAME=""
QUIT
SET BLK=0
FOR
SET BLK=$ORDER(A("NAME",NAME,BLK))
if 'BLK
QUIT
Begin DoDot:2
+15 WRITE !,"Moving Block '"_NAME_"' from form '"_FORMNM_"' to utility"
+16 ;Q:$O(^IBE(357.1,"B",NAME,0)) ;quit if same block from same form
+17 SET NEWBLOCK=$$COPYBLK^IBDFU2(BLK,"",357.1,358.1,"","",1)
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
AUTOINS ; -- auto install tool kit into production
+1 NEW FORM,NEWFORM,FORMNM,CNT,CNT1,ARY,NAME,X,Y,NEWBLOCK,A,EXCLUDE,BLK,CNTF,CNTB
+2 WRITE !!,">>> Now Attempting to automatically update Tool Kit forms and Tool Kit Blocks."
+3 SET (CNTB,CNTF)=0
+4 ;
+5 ; -- add all tool kit blocks
+6 SET FORMNM="TOOL KIT"
+7 IF '$ORDER(^IBE(357,"B",FORMNM,0))
GOTO FRM
+8 SET ORD=""
FOR
SET ORD=$ORDER(^IBE(358.1,"D",ORD))
if ORD=""
QUIT
SET BLK=0
FOR
SET BLK=$ORDER(^IBE(358.1,"D",ORD,BLK))
if 'BLK
QUIT
Begin DoDot:1
+9 SET NAME=$PIECE($GET(^IBE(358.1,+BLK,0)),"^")
+10 ;not toolkit
if $PIECE($GET(^IBE(358.1,BLK,0)),"^",14)'=1
QUIT
+11 ;already installed
if $ORDER(^IBE(357.1,"B",NAME,0))
QUIT
+12 WRITE !," Moving Block '"_$PIECE($GET(^IBE(358.1,+BLK,0)),"^")_"' from import/export to Tool Kit"
+13 NEW IBTKBLK
SET IBTKBLK=1
+14 SET NEWBLOCK=$$COPYBLK^IBDFU2(BLK,$$TKFORM^IBDFU2C,358.1,357.1,"","",$$TKORDER^IBDF13)
SET CNTB=CNTB+1
+15 if $GET(NEWBLOCK)
DO DLTBLK^IBDFU3(BLK,"",358.1)
End DoDot:1
+16 ;
FRM ; -- Add tool kit forms
+1 FOR CNT=1:1
SET FORMNM=$PIECE($TEXT(FORMS+CNT),";;",2,99)
if FORMNM=""
QUIT
Begin DoDot:1
+2 SET FORM=$ORDER(^IBE(358,"B",$EXTRACT(FORMNM,1,30),0))
+3 if $ORDER(^IBE(357,"B",$EXTRACT(FORMNM,1,30),0))
QUIT
+4 WRITE !," Moving Form '"_FORMNM_"' from import export utility to AICS"
+5 SET NEWFORM=$$COPYFORM^IBDFU2C(FORM,358,357,"",1)
SET CNTF=CNTF+1
End DoDot:1
+6 ;
+7 IF CNTF=0
IF CNTB=0
WRITE !!,">>> Tool Kit Forms and Blocks are already installed."
QUIT
+8 WRITE !!,">>> Tool Kit Forms sent (4): ",$JUSTIFY(CNTF,3)_" installed"
+9 WRITE !,">>> Tool Kit Blocks sent (28): ",$JUSTIFY(CNTB,3)_" installed"
+10 QUIT
+11 ;
FORMS ;;
+1 ;;DEFAULTS
+2 ;;
+3 ;;
+4 ;;AMBULATORY SURGERY SAMPLE V2.1
+5 ;;EMERGENCY SERVICES SAMPLE V2.1
+6 ;;PRIMARY CARE SAMPLE V2.1
+7 ;;
BLOCKS ;;
+1 ;;TOOL KIT
+2 ;;
