- IB20PT2 ;ALB/CJM - CREATE FILE ENTRIES NEEDED BY THE ENCOUNTER FORM UTILITIES ;AUG 20,1993
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;
- ; - make an entry in the PACKAGE file for the import/export utility
- D MAKEPKG
- ;
- ; - make two required entries in the ENCOUNTER FORM file (#357)
- D MAKEFORM
- Q
- ;
- ;
- MAKEPKG ; if the package entry for the import/export utility does not
- ; already exist this will create one
- ;
- N NAME,PKG
- S NAME="IB ENCOUNTER FORM IMP/EXP"
- Q:$O(^DIC(9.4,"B",NAME,0))
- ;
- W !!,">>> Creating a PACKAGE (#9.4) file entry for the Encounter Form",!?4,"Import/Export Utility... "
- ;
- K DIC,DD,D0,DINUM S DIC="^DIC(9.4,",DIC(0)="",X=NAME
- D FILE^DICN K DIC,DIE,DA S PKG=+Y
- I PKG<0 W "Unable to create entry -- please call your supporting ISC." Q
- ;
- ;hard code the record
- ;
- S ^DIC(9.4,PKG,0)="IB ENCOUNTER FORM IMP/EXP^IBDE^The import/export utilities for encounter forms."
- S ^DIC(9.4,PKG,4,0)="^9.44PA^10^10"
- S ^DIC(9.4,PKG,4,1,0)="358"
- S ^DIC(9.4,PKG,4,1,222)="y^n^^n^^^y^o^n"
- S ^DIC(9.4,PKG,4,2,0)="358.1"
- S ^DIC(9.4,PKG,4,2,222)="y^n^^n^^^y^o^n"
- S ^DIC(9.4,PKG,4,3,0)="358.2"
- S ^DIC(9.4,PKG,4,3,222)="y^n^^n^^^y^o^n"
- S ^DIC(9.4,PKG,4,4,0)="358.3"
- S ^DIC(9.4,PKG,4,4,222)="y^n^^n^^^y^o^n"
- S ^DIC(9.4,PKG,4,5,0)="358.4"
- S ^DIC(9.4,PKG,4,5,222)="y^n^^n^^^y^o^n"
- S ^DIC(9.4,PKG,4,6,0)="358.5"
- S ^DIC(9.4,PKG,4,6,222)="y^n^^n^^^y^o^n"
- S ^DIC(9.4,PKG,4,7,0)="358.6"
- S ^DIC(9.4,PKG,4,7,222)="y^n^^n^^^y^o^n"
- S ^DIC(9.4,PKG,4,8,0)="358.7"
- S ^DIC(9.4,PKG,4,8,222)="y^n^^n^^^y^o^n"
- S ^DIC(9.4,PKG,4,9,0)="358.8"
- S ^DIC(9.4,PKG,4,9,222)="y^n^^n^^^y^o^n"
- S ^DIC(9.4,PKG,4,10,0)="358.91"
- S ^DIC(9.4,PKG,4,10,222)="y^n^^n^^^y^o^n"
- S ^DIC(9.4,PKG,5)="ALBANY"
- S ^DIC(9.4,PKG,11)="358^358.1"
- S ^DIC(9.4,PKG,22,0)="^9.49I^1^1"
- S ^DIC(9.4,PKG,22,1,0)="2.0^2930818^2930820"
- S ^DIC(9.4,PKG,"VERSION")="2.0"
- ;
- ;now index the package entry
- ;
- K DIK,DA S DIK="^DIC(9.4,",DA=PKG D IX1^DIK K DIK,DA
- W "done."
- Q
- MAKEFORM ;creates two required tool kit forms - GARBAGE, and TOOL KIT
- ;
- N NAME,NODE
- S NAME="TOOL KIT",NODE="TOOL KIT^^Contains all of the tool kit blocks.^0^^^1^^132^80^4"
- D FORM
- S NAME="GARBAGE",NODE="GARBAGE^^Used as temporary storage for blocks while they are being edited.^0^^^1^^132^200^5"
- D FORM
- Q
- ;
- FORM ;create the form - NAME and NODE should be defined
- N FORM
- ;if the form already exists, don't create another
- Q:$O(^IBE(357,"B",NAME,0))
- W !!,">>> Creating an entry in the ENCOUNTER FORM file (#357) required by the",!?4,"Encounter Form Utilities... "
- K DIC,DD,DO,DINUM S DIC="^IBE(357,",X=NAME,DIC(0)=""
- D FILE^DICN K DIC,DIE S FORM=+Y
- I FORM<0 W "Unable to create entry -- please call your supporting ISC." Q
- ;
- ;copy old 0 node into the new form
- S ^IBE(357,FORM,0)=NODE
- ;
- ;now index it
- K DIK,DA S DA=FORM,DIK="^IBE(357," D IX1^DIK K DIK,DA
- W "done"
- Q
- IB20PT2 ;ALB/CJM - CREATE FILE ENTRIES NEEDED BY THE ENCOUNTER FORM UTILITIES ;AUG 20,1993
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;
- +3 ; - make an entry in the PACKAGE file for the import/export utility
- +4 DO MAKEPKG
- +5 ;
- +6 ; - make two required entries in the ENCOUNTER FORM file (#357)
- +7 DO MAKEFORM
- +8 QUIT
- +9 ;
- +10 ;
- MAKEPKG ; if the package entry for the import/export utility does not
- +1 ; already exist this will create one
- +2 ;
- +3 NEW NAME,PKG
- +4 SET NAME="IB ENCOUNTER FORM IMP/EXP"
- +5 IF $ORDER(^DIC(9.4,"B",NAME,0))
- QUIT
- +6 ;
- +7 WRITE !!,">>> Creating a PACKAGE (#9.4) file entry for the Encounter Form",!?4,"Import/Export Utility... "
- +8 ;
- +9 KILL DIC,DD,D0,DINUM
- SET DIC="^DIC(9.4,"
- SET DIC(0)=""
- SET X=NAME
- +10 DO FILE^DICN
- KILL DIC,DIE,DA
- SET PKG=+Y
- +11 IF PKG<0
- WRITE "Unable to create entry -- please call your supporting ISC."
- QUIT
- +12 ;
- +13 ;hard code the record
- +14 ;
- +15 SET ^DIC(9.4,PKG,0)="IB ENCOUNTER FORM IMP/EXP^IBDE^The import/export utilities for encounter forms."
- +16 SET ^DIC(9.4,PKG,4,0)="^9.44PA^10^10"
- +17 SET ^DIC(9.4,PKG,4,1,0)="358"
- +18 SET ^DIC(9.4,PKG,4,1,222)="y^n^^n^^^y^o^n"
- +19 SET ^DIC(9.4,PKG,4,2,0)="358.1"
- +20 SET ^DIC(9.4,PKG,4,2,222)="y^n^^n^^^y^o^n"
- +21 SET ^DIC(9.4,PKG,4,3,0)="358.2"
- +22 SET ^DIC(9.4,PKG,4,3,222)="y^n^^n^^^y^o^n"
- +23 SET ^DIC(9.4,PKG,4,4,0)="358.3"
- +24 SET ^DIC(9.4,PKG,4,4,222)="y^n^^n^^^y^o^n"
- +25 SET ^DIC(9.4,PKG,4,5,0)="358.4"
- +26 SET ^DIC(9.4,PKG,4,5,222)="y^n^^n^^^y^o^n"
- +27 SET ^DIC(9.4,PKG,4,6,0)="358.5"
- +28 SET ^DIC(9.4,PKG,4,6,222)="y^n^^n^^^y^o^n"
- +29 SET ^DIC(9.4,PKG,4,7,0)="358.6"
- +30 SET ^DIC(9.4,PKG,4,7,222)="y^n^^n^^^y^o^n"
- +31 SET ^DIC(9.4,PKG,4,8,0)="358.7"
- +32 SET ^DIC(9.4,PKG,4,8,222)="y^n^^n^^^y^o^n"
- +33 SET ^DIC(9.4,PKG,4,9,0)="358.8"
- +34 SET ^DIC(9.4,PKG,4,9,222)="y^n^^n^^^y^o^n"
- +35 SET ^DIC(9.4,PKG,4,10,0)="358.91"
- +36 SET ^DIC(9.4,PKG,4,10,222)="y^n^^n^^^y^o^n"
- +37 SET ^DIC(9.4,PKG,5)="ALBANY"
- +38 SET ^DIC(9.4,PKG,11)="358^358.1"
- +39 SET ^DIC(9.4,PKG,22,0)="^9.49I^1^1"
- +40 SET ^DIC(9.4,PKG,22,1,0)="2.0^2930818^2930820"
- +41 SET ^DIC(9.4,PKG,"VERSION")="2.0"
- +42 ;
- +43 ;now index the package entry
- +44 ;
- +45 KILL DIK,DA
- SET DIK="^DIC(9.4,"
- SET DA=PKG
- DO IX1^DIK
- KILL DIK,DA
- +46 WRITE "done."
- +47 QUIT
- MAKEFORM ;creates two required tool kit forms - GARBAGE, and TOOL KIT
- +1 ;
- +2 NEW NAME,NODE
- +3 SET NAME="TOOL KIT"
- SET NODE="TOOL KIT^^Contains all of the tool kit blocks.^0^^^1^^132^80^4"
- +4 DO FORM
- +5 SET NAME="GARBAGE"
- SET NODE="GARBAGE^^Used as temporary storage for blocks while they are being edited.^0^^^1^^132^200^5"
- +6 DO FORM
- +7 QUIT
- +8 ;
- FORM ;create the form - NAME and NODE should be defined
- +1 NEW FORM
- +2 ;if the form already exists, don't create another
- +3 IF $ORDER(^IBE(357,"B",NAME,0))
- QUIT
- +4 WRITE !!,">>> Creating an entry in the ENCOUNTER FORM file (#357) required by the",!?4,"Encounter Form Utilities... "
- +5 KILL DIC,DD,DO,DINUM
- SET DIC="^IBE(357,"
- SET X=NAME
- SET DIC(0)=""
- +6 DO FILE^DICN
- KILL DIC,DIE
- SET FORM=+Y
- +7 IF FORM<0
- WRITE "Unable to create entry -- please call your supporting ISC."
- QUIT
- +8 ;
- +9 ;copy old 0 node into the new form
- +10 SET ^IBE(357,FORM,0)=NODE
- +11 ;
- +12 ;now index it
- +13 KILL DIK,DA
- SET DA=FORM
- SET DIK="^IBE(357,"
- DO IX1^DIK
- KILL DIK,DA
- +14 WRITE "done"
- +15 QUIT
