source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMP10I.m@ 1397

PXRMP10I ; SLC/PKR - PXRM*2.0*10 init routine. ;09/28/2007
 ;;2.0;CLINICAL REMINDERS;**10**;Feb 04, 2005;Build 25
 Q
 ;
DELEI ;If the Exchange File entry already exists delete it.
 N ARRAY,IC,IND,LIST,LUVALUE,NUM
 D EXARRAY("L",.ARRAY)
 S IC=0
 F  S IC=$O(ARRAY(IC)) Q:'IC  D
 . S LUVALUE(1)=ARRAY(IC,1)
 . D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
 . I '$D(LIST) Q
 . S NUM=$P(LIST("DILIST",0),U,1)
 . I NUM'=0 D
 .. F IND=1:1:NUM D
 ... N DA,DIK
 ... S DIK="^PXD(811.8,"
 ... S DA=LIST("DILIST",2,IND)
 ... D ^DIK
 Q
 ;==========================================
DITEMAR(DIEN,ARRAY) ;
 ;DIEN is the IEN of the dialog top level
 ;Array contains the dialog elements and groups within the dialog.
 N CNT,IEN,REPIEN,TYPE
 S CNT=0 F  S CNT=$O(^PXRMD(801.41,DIEN,10,CNT)) Q:CNT'>0  D
 .S IEN=$P($G(^PXRMD(801.41,DIEN,10,CNT,0)),U,2) Q:IEN'>0
 .S REPIEN=$P($G(^PXRMD(801.41,IEN,49)),U,3)
 .I REPIEN>0 D DITEMAR(REPIEN,.ARRAY)
 .S TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
 .I TYPE="G"!(TYPE="E") D DITEMAR(IEN,.ARRAY)
 .I '$D(ARRAY(IEN)) S ARRAY(IEN)=""
 I '$D(ARRAY(DIEN)) S ARRAY(DIEN)=""
 Q
 ;
DMAKENAT(DA) ;
 N CLASS,DIE,DR,IEN,NAME,NEWNAME,PREFIX,TYPE
 S NAME=$P($G(^PXRMD(801.41,DA,0)),U)
 I $E(NAME,1,3)="VA-"!($E(NAME,1,4)="PXRM") Q
 S CLASS="N"
 S DIE="^PXRMXD(801.41,"
 S DR="100////^S X=CLASS"
 D ^DIE
 S TYPE=$P($G(^PXRMD(801.41,DA,0)),U,4)
 S PREFIX=$S(TYPE="R":"VA-",TYPE="G":"VA-",TYPE="E":"VA-",1:"PXRM ")
 S NEWNAME=PREFIX_NAME
 D RENAME(801.41,NAME,NEWNAME)
 Q
 ;
EXARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install
 N CNT
 S CNT=0
 ;
 S CNT=CNT+1,ARRAY(CNT,1)="VA-VANOD SKIN ASSESSMENT"
 I MODE["I" S ARRAY(CNT,2)="07/16/2007@14:45:37"
 I MODE["A" S ARRAY(CNT,3)="O"
 ;
 S CNT=CNT+1,ARRAY(CNT,1)="VA-VANOD SKIN REASSESSMENT"
 I MODE["I" S ARRAY(CNT,2)="07/16/2007@14:46:02"
 I MODE["A" S ARRAY(CNT,3)="O"
 ;
 S CNT=CNT+1,ARRAY(CNT,1)="GMTS SKIN RISK HS TYPES"
 I MODE["I" S ARRAY(CNT,2)="07/09/2007@13:20:09"
 I MODE["A" S ARRAY(CNT,3)="O"
 ;
 S CNT=CNT+1,ARRAY(CNT,1)="GMTS SKIN RISK HS OBJECTS"
 I MODE["I" S ARRAY(CNT,2)="07/09/2007@13:21:13"
 I MODE["A" S ARRAY(CNT,3)="O"
 Q
 ;
 ;==========================================
EXFINC(Y) ;Return a 1 if the Exchange file entry is in the list to
 ;include in the build. This is used in the build to determine which
 ;entries to include.
 N EXARRAY,FOUND,IEN,IC,LUVALUE
 D EXARRAY("I",.EXARRAY)
 S FOUND=0
 S IC=0
 F  S IC=+$O(EXARRAY(IC)) Q:(IC=0)!(FOUND)  D
 . M LUVALUE=EXARRAY(IC)
 . S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
 . I IEN=Y S FOUND=1 Q
 Q FOUND
 ;
NATCONV ;
 N ARRAY,CLASS,CNT,DA,DIE,DIEN,DR,IEN,NAME,PXRMEXCH,PXRMINST,RIEN
 S PXRMEXCH=1,PXRMINST=1,CLASS="N"
 F NAME="VANOD SKIN ASSESSMENT","VANOD SKIN REASSESSMENT" D
 .S RIEN=$O(^PXD(811.9,"B",NAME,"")) Q:RIEN'>0
 .S DA=RIEN,DIE="^PXD(811.9,",DR="100///^S X=CLASS"
 .D ^DIE
 .D RENAME(811.9,NAME,"VA-"_NAME)
 .S DIEN=$P($G(^PXD(811.9,RIEN,51)),U) Q:DIEN'>0
 .D DITEMAR(DIEN,.ARRAY)
 .S IEN=0 F  S IEN=$O(ARRAY(IEN)) Q:IEN'>0  D
 ..D DMAKENAT(IEN)
 .D DMAKENAT(DIEN)
 Q
 ;
PRE ;
 D DELEI
 D NATCONV
 Q
 ;
POST ;
 D SMEXINS
 Q
 ;
RENAME(FILENUM,OLDNAME,NEWNAME) ;Rename entry OLDNAME to NEWNAME in
 ;file number FILENUM.
 N DA,DIE,DR,NIEN
 S NIEN=$$FIND1^DIC(FILENUM,"","BX",NEWNAME) I NIEN>0 Q
 S DA=$$FIND1^DIC(FILENUM,"","BX",OLDNAME)
 I DA=0 Q
 S DIE=FILENUM
 S DR=".01///^S X=NEWNAME"
 D ^DIE
 Q
 ;
SENDDLG(IEN) ;
 N NAME
 S NAME=$P($G(^PXRMD(801.41,IEN,0)),U)
 I NAME="PXRM BRADEN 6-8" Q 1
 I NAME="PXRM BRADEN 10-12" Q 1
 I NAME="PXRM BRADEN 13-14" Q 1
 I NAME="PXRM BRADEN 15-18" Q 1
 I NAME="PXRM BRADEN 19-23" Q 1
 I NAME="PXRM VANOD PU LOCATIONS" Q 1
 I NAME="PXRM VANOD SKIN COLOR" Q 1
 I NAME="PXRM VANOD SKIN MOISTURE" Q 1
 I NAME="PXRM VANOD SKIN TEMP" Q 1
 I NAME="PXRM VANOD SKIN TURGOR" Q 1
 I NAME="PXRM VANOD DATE FORCED TODAY" Q 1
 Q 0
 ;
SMEXINS ;Silent mode install
 N ACTION,EXARRAY,IC,IEN,LUVALUE,PXRMINST,TEXT
 S PXRMINST=1
 D EXARRAY("IA",.EXARRAY)
 S IC=0
 F  S IC=$O(EXARRAY(IC)) Q:'IC  D
 .I EXARRAY(IC,1)["GMTS" Q
 .S LUVALUE(1)=EXARRAY(IC,1),LUVALUE(IC,2)=EXARRAY(IC,2)
 .S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
 .I IEN'=0 D
 .. N TEXT
 .. I LUVALUE(1)["PARAMETER" S TEXT="Installing entry "_LUVALUE(1)
 .. E  S TEXT="Installing reminder "_LUVALUE(1)
 .. D BMES^XPDUTL(TEXT)
 .. I $$PATCH^XPDUTL("PXRM*2.0*6") D
 ... S ACTION=EXARRAY(IC,3)
 ... D INSTALL^PXRMEXSI(IEN,ACTION,1)
 .. I '$$PATCH^XPDUTL("PXRM*2.0*6") D INSTALL^PXRMEXSI(IEN,1)
 Q
 ;