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

VENPCCML.m

Go to the documentation of this file. 
  1. VENPCCML ; IHS/OIT/GIS - CLONE AND DELETE PREFERENCES ;
  1.  ;;2.6;PCC+;;NOV 12, 2007
  1.  ;
  1.  ;
  1.  ; 
  1. ICD ; EP-CLONE USER ICD PREFERENCES
  1. NEW N SOURCE,TARGET,LAST,DIC,X,Y,%,DUOUT,DTOUT,DA,DIK,PIEN,D0,DDH,DG,DICR,DIU,TOT,CNT,POP,%Y,PIEN
  1.  W !!!
  1. FROM S DIC("A")="Copy preferences from: "
  1.  S DIC=200,DIC(0)="AEQI"
  1.  D ^DIC K DIC I Y=-1 Q
  1.  I '$D(^VEN(7.1,"B",+Y)) W !,"This provider has no preferences on file!",!,"Please select another provider or enter '^' to exit...",! G FROM
  1.  S SOURCE=+Y
  1. TO S DIC("A")="Copy preference to: "
  1.  S DIC=200,DIC(0)="AEQI"
  1.  D ^DIC K DIC I Y=-1 Q
  1.  I +Y=SOURCE W !,"You can not clone preferences from a provider to him/herself.",!,"Select another provider or enter '^' to exit...",! G TO
  1.  I $D(^VEN(7.1,"B",+Y)) W !,"This provider already has preferences on file!" W !,"Want to completely replace the old set of preferences" S %=2 D YN^DICN Q:$G(%Y)?1."^"  I %=2 Q
  1.  S TARGET=+Y
  1.  S %=1 W !,"Are you sure" D YN^DICN I %'=1 Q
  1.  D WAIT^DICD
  1.  I $D(^VEN(7.1,"B",+Y)) W !,"Deleting the old preferences..." S DIK="^VEN(7.1,",DA=0 F  S DA=$O(^VEN(7.1,"B",TARGET,DA)) Q:'DA  D ^DIK ; DELETE OLD PREFERENCES BEFORE REPLACING THEM
  1.  W !,"Cloning preferences..."
  1.  S LAST=$O(^VEN(7.1,999999999),-1) I 'LAST Q
  1. MERGE S DIK="^VEN(7.1,",TOT=0 ; RE-INDEX REFERENCE THE FILE
  1.  S PIEN=0 F  S PIEN=$O(^VEN(7.1,"B",SOURCE,PIEN)) Q:'PIEN  D
  1.  . S %=$G(^VEN(7.1,PIEN,0)) I '$L(%) Q
  1.  . S $P(%,U)=TARGET
  1.  . S $P(%,U,5)=""
  1.  . S TOT=TOT+1,DA=TOT+LAST
  1.  . S ^VEN(7.1,DA,0)=%
  1.  . D IX1^DIK ; CREATE INDICES FOR THIS NEW ENTRY
  1.  W !!,"DONE!",! H 2
  1.  D ^XBFMK
  1.  Q
  1.  ; 
  1. ICDD ; EP-DELETE A SET OF ICD PREFERENCES
  1.  N X,Y,%,PIEN,DIC,DA,DIK,USER,POP
  1.  W !!!
  1.  S DIC("A")="Delete preferences from: "
  1.  S DIC=200,DIC(0)="AEQI",DIC("S")="I $D(^VEN(7.1,""B"",Y))"
  1.  D ^DIC K DIC I Y=-1 Q
  1.  S USER=+Y
  1.  S %=1 W !,"Are you sure" D YN^DICN I %'=1 Q
  1.  D WAIT^DICD
  1.  S DIK="^VEN(7.1,",DA=0 F  S DA=$O(^VEN(7.1,"B",USER,DA)) Q:'DA  D ^DIK
  1.  W !!,"DONE!" H 2
  1.  D ^XBFMK
  1.  Q
  1.  ; 
  1. CORD ;EP-CLONE CPT SETS
  1.  N %,DIC,OLD,NEW,LAST,DIK,MMF,IEN,DA,TOT
  1.  D CLEAN
  1.  I '$O(^VEN(7.93,"AS",0))!('$O(^VEN(7.92,0))) S %=$$INIT Q:'%  S OLD=% G C1
  1.  S DIC("A")="Enter the name of the Orderable Set to copy from: "
  1.  S DIC(0)="AEQ",DIC="^VEN(7.92," D ^DIC I Y=-1 Q
  1.  S OLD=+Y
  1. C1 S DIC("A")="Enter the name of the new Set of Orderables: "
  1.  S DLAYGO=19707.92,DIC(0)="AEQL",DIC="^VEN(7.92," D ^DIC I Y=-1!('$P(Y,U,3)) D ^XBFMK Q
  1.  W !,"One moment please..."
  1.  S NEW=+Y,LAST=$O(^VEN(7.93,999999999),-1),DIK="^VEN(7.93,",TOT=0,MMF=""
  1.  F  S MMF=$O(^VEN(7.93,"AS",OLD,MMF)) Q:MMF=""  S IEN=0 F  S IEN=$O(^VEN(7.93,"AS",OLD,MMF,IEN)) Q:'IEN  D
  1.  . S TOT=TOT+1
  1.  . S DA=LAST+TOT I (DA#25)=0 W "."
  1.  . M ^VEN(7.93,DA)=^VEN(7.93,IEN)
  1.  . S $P(^VEN(7.93,DA,0),U,2)=NEW,$P(^VEN(7.93,DA,0),U,11)=""
  1.  . D IX^DIK
  1.  . Q
  1.  W !,"The orderable set has been cloned!"
  1. C2 S %=1 W !,"Want to link this new order set to a template" D YN^DICN I %=1 D LINK(NEW)
  1.  D ^XBFMK
  1.  Q
  1.  ; 
  1. DORD ; EP-DELETE AN ORDERABLE SET
  1.  N X,Y,%,DIC,DIE,DR,DA,SET,DIK,MMF
  1.  I '$O(^VEN(7.92,0)) W !,"No orderable sets have been defined!  Request cancelled..." Q
  1.  D CLEAN
  1.  S DIC("A")="Delete what order set: "
  1.  S DIC(0)="AEQ",DIC="^VEN(7.92," D ^DIC I Y=-1 Q
  1.  S SET=+Y
  1.  S %=1 W !,"Are you sure you want to delete this orderable set" D YN^DICN I %'=1 Q
  1. ONE S %=$O(^VEN(7.92,0)) I %,'$O(^VEN(7.92,%)) D  Q  ; RESTORE TO THE PRISTINE STATE IF THERE IS ONLY ONE ORDER SET
  1.  . S DIE="^VEN(7.93,",DR=".02///@"
  1.  . S DA=0 F  S DA=$O(^VEN(7.93,DA)) Q:'DA  L +^VEN(7.93,DA):0 I $T D ^DIE L -^VEN(7.93,DA)  ; REMOVE ALL ORDER SETS FROM ORDERABLES BUT DONT REMOVE ORDERABLES
  1.  . S DIE="^VEN(7.41,",DR=".09///@"
  1.  . S DA=0 F  S DA=$O(^VEN(7.41,DA)) Q:'DA  L +^VEN(7.41,DA):0 I $T D ^DIE L -^VEN(7.41,DA)  ; REMOVE ALL ORDER SETS FROM TEMPLATES BUT DOT REMOVE TEMPLATES
  1.  . S DIK="^VEN(7.92,",DA=SET D ^DIK  ; DELETE THE ORDER SET
  1.  . W !,"The only defined order set has been removed and ",!,"templates and orderabes are no longer associated with any order sets!"
  1.  . D ^XBFMK
  1.  . Q
  1. D1 S MMF="",DIK="^VEN(7.93,"
  1.  F  S MMF=$O(^VEN(7.93,"AS",SET,MMF)) Q:MMF=""  S DA=0 F  S DA=$O(^VEN(7.93,"AS",SET,MMF,DA)) Q:'DA  D ^DIK ; REMOVE ORDER SET FROM ALL ASSOCIATED ORDERABLES
  1.  W !,"All orderables associated with this order set have been deleted!"
  1.  W !,"The following templates are no longer linked to an order set:"
  1.  S DIE="^VEN(7.41,",DR=".09///@"
  1.  S DA=0 F  S DA=$O(^VEN(7.41,DA)) Q:'DA  S %=$P($G(^VEN(7.41,DA,0)),U,9) I %=SET D
  1.  . W !?5,$P($G(^VEN(7.41,DA,0)),U)
  1.  . L +^VEN(7.41,DA):0 I $T D ^DIE L -^VEN(7.41,DA) ; REMOVE ORDER SET FROM TEMPLATE
  1.  . Q
  1.  S DIK="^VEN(7.92,",DA=SET D ^DIK  ; DELETE THE ORDER SET
  1.  W !,"Order set deleted!"
  1.  D ^XBFMK
  1.  Q
  1.  ; 
  1. INIT() ; EP-INITIALIZE THE PRIMARY ORDERABLE SET
  1.  N DIC,Y,X,OSET,%,DA,DR,DIE,%Y
  1.  I $O(^VEN(7.93,"AS",0)) Q 0
  1.  W !,"No order sets have been created yet..."
  1.  W !,"You must initialize the primary order set before it can be cloned."
  1.  W !,"Want to initialize the primary order set"
  1.  S %=1 D YN^DICN I %'=1 D ^XBFMK Q 0
  1.  S DLAYGO=19707.92,DIC="^VEN(7.92,",DIC(0)="AEQL",DIC("A")="Name of primary orderable set: "
  1.  I '$O(^VEN(7.92,0)) S DIC("B")="GENERIC ORDER SET"
  1.  D ^DIC I Y=-1 D ^XBFMK Q 0
  1.  S OSET=+Y
  1.  W !!,"OK, all current orderables will be associated with ",$P(Y,U,2)
  1.  W !,"All existing templates will be linked to this order set as well"
  1.  W !,"In the future, all new templates must be linked to an order set"
  1.  W !,"Are you sure you want to go on"
  1.  S %=1 D YN^DICN I %'=1 D ^XBFMK Q 0
  1.  W !,"One moment please..."
  1.  S DIE="^VEN(7.93,",DR=".02////^S X=OSET"
  1.  S DA=0 F  S DA=$O(^VEN(7.93,DA)) Q:'DA  L +^VEN(7.93,DA):0 I $T D ^DIE L -^VEN(7.93,DA) W:(DA#25)=0 "."
  1.  S DIE="^VEN(7.41,",DR=".09////^S X=OSET"
  1.  S DA=0 F  S DA=$O(^VEN(7.41,DA)) Q:'DA  L +^VEN(7.41,DA):0 I $T D ^DIE L -^VEN(7.41,DA)
  1.  W !,"Done!"
  1.  D ^XBFMK
  1.  Q OSET
  1.  ; 
  1.  N X,%,DA,DR,DIE,DIC
  1.  S DIC("A")="Template: ",DIC="^VEN(7.41,",DIC(0)="AEQ"
  1.  D ^DIC I Y=-1 Q
  1.  S DIE=DIC,DA=+Y,DR=".09"
  1.  I $G(NEW) S DR=DR_"////"_+NEW
  1.  L +^VEN(7.41,DA):0 I $T D ^DIE L -^VEN(7.41,DA)
  1.  D ^XBFMK
  1.  W !,"Done!"
  1.  Q
  1.  ; 
  1. CLEAN ; EP-CLEAN OUT ALL INCOMPLETE ENTRIES
  1.  N DA,X,DIK
  1.  S DA=0,DIK="^VEN(7.93,"
  1.  F  S DA=$O(^VEN(7.93,DA)) Q:'DA  S X=$G(^(DA,0)) I $P(X,U,3)="" D ^DIK
  1.  Q
  1.  ;