| [613] | 1 | IBDE4 ;ALB/AAS - PUT FORMS AND BLOCKS INTO IMPORT/EXPORT UTILTIY ;AUG 12,1993
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | ADD ; -- add forms to the import exort utility
|
|---|
| 5 | N FORM,NEWFORM,FORMNM,CNT,CNT1,ARY,NAME,X,Y,NEWBLOCK,A,EXCLUDE,BLK
|
|---|
| 6 | F CNT=1:1 S FORMNM=$P($T(FORMS+CNT),";;",2,99) Q:FORMNM="" D
|
|---|
| 7 | .S FORM=$O(^IBE(357,"B",$E(FORMNM,1,30),0))
|
|---|
| 8 | .Q:$O(^IBE(358,"B",$E(FORMNM,1,30),0))
|
|---|
| 9 | .W !,"Moving Form '"_FORMNM_"' to import export utility"
|
|---|
| 10 | .S NEWFORM=$$COPYFORM^IBDFU2C(FORM,357,358,"",1)
|
|---|
| 11 | ;
|
|---|
| 12 | ; -- add all blocks for a form
|
|---|
| 13 | F CNT=1:1 S FORMNM=$P($T(BLOCKS+CNT),";;",2,99) Q:FORMNM="" D
|
|---|
| 14 | .S FORM=$O(^IBE(357,"B",$E(FORMNM,1,30),0))
|
|---|
| 15 | .Q:$O(^IBE(358,"B",$E(FORMNM,1,30),0))
|
|---|
| 16 | .S ARY="A",EXCLUDE="" K A
|
|---|
| 17 | .S CNT1=$$FINDALL^IBDFU8
|
|---|
| 18 | .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
|
|---|
| 19 | ..W !,"Moving Block '"_NAME_"' from form '"_FORMNM_"' to utility"
|
|---|
| 20 | ..;Q:$O(^IBE(357.1,"B",NAME,0)) ;quit if same block from same form
|
|---|
| 21 | ..S NEWBLOCK=$$COPYBLK^IBDFU2(BLK,"",357.1,358.1,"","",1)
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | AUTOINS ; -- auto install tool kit into production
|
|---|
| 25 | N FORM,NEWFORM,FORMNM,CNT,CNT1,ARY,NAME,X,Y,NEWBLOCK,A,EXCLUDE,BLK,CNTF,CNTB
|
|---|
| 26 | W !!,">>> Now Attempting to automatically update Tool Kit forms and Tool Kit Blocks."
|
|---|
| 27 | S (CNTB,CNTF)=0
|
|---|
| 28 | ;
|
|---|
| 29 | ; -- add all tool kit blocks
|
|---|
| 30 | S FORMNM="TOOL KIT"
|
|---|
| 31 | I '$O(^IBE(357,"B",FORMNM,0)) G FRM
|
|---|
| 32 | 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
|
|---|
| 33 | .S NAME=$P($G(^IBE(358.1,+BLK,0)),"^")
|
|---|
| 34 | .Q:$P($G(^IBE(358.1,BLK,0)),"^",14)'=1 ;not toolkit
|
|---|
| 35 | .Q:$O(^IBE(357.1,"B",NAME,0)) ;already installed
|
|---|
| 36 | .W !," Moving Block '"_$P($G(^IBE(358.1,+BLK,0)),"^")_"' from import/export to Tool Kit"
|
|---|
| 37 | .N IBTKBLK S IBTKBLK=1
|
|---|
| 38 | .S NEWBLOCK=$$COPYBLK^IBDFU2(BLK,$$TKFORM^IBDFU2C,358.1,357.1,"","",$$TKORDER^IBDF13),CNTB=CNTB+1
|
|---|
| 39 | .D:$G(NEWBLOCK) DLTBLK^IBDFU3(BLK,"",358.1)
|
|---|
| 40 | ;
|
|---|
| 41 | FRM ; -- Add tool kit forms
|
|---|
| 42 | F CNT=1:1 S FORMNM=$P($T(FORMS+CNT),";;",2,99) Q:FORMNM="" D
|
|---|
| 43 | .S FORM=$O(^IBE(358,"B",$E(FORMNM,1,30),0))
|
|---|
| 44 | .Q:$O(^IBE(357,"B",$E(FORMNM,1,30),0))
|
|---|
| 45 | .W !," Moving Form '"_FORMNM_"' from import export utility to AICS"
|
|---|
| 46 | .S NEWFORM=$$COPYFORM^IBDFU2C(FORM,358,357,"",1),CNTF=CNTF+1
|
|---|
| 47 | ;
|
|---|
| 48 | I CNTF=0,CNTB=0 W !!,">>> Tool Kit Forms and Blocks are already installed." Q
|
|---|
| 49 | W !!,">>> Tool Kit Forms sent (4): ",$J(CNTF,3)_" installed"
|
|---|
| 50 | W !,">>> Tool Kit Blocks sent (28): ",$J(CNTB,3)_" installed"
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | FORMS ;;
|
|---|
| 54 | ;;DEFAULTS
|
|---|
| 55 | ;;
|
|---|
| 56 | ;;
|
|---|
| 57 | ;;AMBULATORY SURGERY SAMPLE V2.1
|
|---|
| 58 | ;;EMERGENCY SERVICES SAMPLE V2.1
|
|---|
| 59 | ;;PRIMARY CARE SAMPLE V2.1
|
|---|
| 60 | ;;
|
|---|
| 61 | BLOCKS ;;
|
|---|
| 62 | ;;TOOL KIT
|
|---|
| 63 | ;;
|
|---|
