- 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 Feb 18, 2025@23:05:15 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 ;;