Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBDE4

IBDE4.m

Go to the documentation of this file.
  1. IBDE4 ;ALB/AAS - PUT FORMS AND BLOCKS INTO IMPORT/EXPORT UTILTIY ;AUG 12,1993
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
  1. ;
  1. ADD ; -- add forms to the import exort utility
  1. N FORM,NEWFORM,FORMNM,CNT,CNT1,ARY,NAME,X,Y,NEWBLOCK,A,EXCLUDE,BLK
  1. F CNT=1:1 S FORMNM=$P($T(FORMS+CNT),";;",2,99) Q:FORMNM="" D
  1. .S FORM=$O(^IBE(357,"B",$E(FORMNM,1,30),0))
  1. .Q:$O(^IBE(358,"B",$E(FORMNM,1,30),0))
  1. .W !,"Moving Form '"_FORMNM_"' to import export utility"
  1. .S NEWFORM=$$COPYFORM^IBDFU2C(FORM,357,358,"",1)
  1. ;
  1. ; -- add all blocks for a form
  1. F CNT=1:1 S FORMNM=$P($T(BLOCKS+CNT),";;",2,99) Q:FORMNM="" D
  1. .S FORM=$O(^IBE(357,"B",$E(FORMNM,1,30),0))
  1. .Q:$O(^IBE(358,"B",$E(FORMNM,1,30),0))
  1. .S ARY="A",EXCLUDE="" K A
  1. .S CNT1=$$FINDALL^IBDFU8
  1. .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
  1. ..W !,"Moving Block '"_NAME_"' from form '"_FORMNM_"' to utility"
  1. ..;Q:$O(^IBE(357.1,"B",NAME,0)) ;quit if same block from same form
  1. ..S NEWBLOCK=$$COPYBLK^IBDFU2(BLK,"",357.1,358.1,"","",1)
  1. Q
  1. ;
  1. AUTOINS ; -- auto install tool kit into production
  1. N FORM,NEWFORM,FORMNM,CNT,CNT1,ARY,NAME,X,Y,NEWBLOCK,A,EXCLUDE,BLK,CNTF,CNTB
  1. W !!,">>> Now Attempting to automatically update Tool Kit forms and Tool Kit Blocks."
  1. S (CNTB,CNTF)=0
  1. ;
  1. ; -- add all tool kit blocks
  1. S FORMNM="TOOL KIT"
  1. I '$O(^IBE(357,"B",FORMNM,0)) G FRM
  1. 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
  1. .S NAME=$P($G(^IBE(358.1,+BLK,0)),"^")
  1. .Q:$P($G(^IBE(358.1,BLK,0)),"^",14)'=1 ;not toolkit
  1. .Q:$O(^IBE(357.1,"B",NAME,0)) ;already installed
  1. .W !," Moving Block '"_$P($G(^IBE(358.1,+BLK,0)),"^")_"' from import/export to Tool Kit"
  1. .N IBTKBLK S IBTKBLK=1
  1. .S NEWBLOCK=$$COPYBLK^IBDFU2(BLK,$$TKFORM^IBDFU2C,358.1,357.1,"","",$$TKORDER^IBDF13),CNTB=CNTB+1
  1. .D:$G(NEWBLOCK) DLTBLK^IBDFU3(BLK,"",358.1)
  1. ;
  1. FRM ; -- Add tool kit forms
  1. F CNT=1:1 S FORMNM=$P($T(FORMS+CNT),";;",2,99) Q:FORMNM="" D
  1. .S FORM=$O(^IBE(358,"B",$E(FORMNM,1,30),0))
  1. .Q:$O(^IBE(357,"B",$E(FORMNM,1,30),0))
  1. .W !," Moving Form '"_FORMNM_"' from import export utility to AICS"
  1. .S NEWFORM=$$COPYFORM^IBDFU2C(FORM,358,357,"",1),CNTF=CNTF+1
  1. ;
  1. I CNTF=0,CNTB=0 W !!,">>> Tool Kit Forms and Blocks are already installed." Q
  1. W !!,">>> Tool Kit Forms sent (4): ",$J(CNTF,3)_" installed"
  1. W !,">>> Tool Kit Blocks sent (28): ",$J(CNTB,3)_" installed"
  1. Q
  1. ;
  1. FORMS ;;
  1. ;;DEFAULTS
  1. ;;
  1. ;;
  1. ;;AMBULATORY SURGERY SAMPLE V2.1
  1. ;;EMERGENCY SERVICES SAMPLE V2.1
  1. ;;PRIMARY CARE SAMPLE V2.1
  1. ;;
  1. BLOCKS ;;
  1. ;;TOOL KIT
  1. ;;