PXRMEXUINFOPNL ;SLC/PJH,PKR - Reminder Exchange #4, cprs info panel. ;Jun 10, 2024@11:56:30
;;2.0;CLINICAL REMINDERS;**87**;Feb 04, 2005;Build 35
;
; Reference to SETUPDATING^ORIUTL supported by DBIA # 7465 (submit)
; Reference to $$GETNATIONAL^ORIUTL supported by DBIA # 7465 (submit)
; Reference to KILLNATIONAL^ORIUTL supported by DBIA # 7465 (submit)
;
Q
;
EN(FDA) ;
N ALIST,ERRORS,FLD,IDX
S ALIST(101.7112,.02)=101.73,ALIST(101.7112,.05)=101.73,ALIST(101.7112,.08)=101.73
S ALIST(101.71123,.06)=101.73,ALIST(101.71123,.08)=101.73,ALIST(101.71123,13)=101.73
S ALIST(101.71123,13)=101.75,ALIST(101.71123,23)=101.73,ALIST(101.71123,24)=101.73
S ALIST(101.71123,30)=101.73,ALIST(101.71123,32)=101.75,ALIST(101.71123,34)=101.74
S ALIST(191.714,.01)=101.73
;
;I $O(FDA(101.71,""))'="+1," D BMES^XPDUTL("Only National Data can be installed.") S PXRMDONE=1 Q
;LOC subscript
D PROCESS(.FDA,.ALIST,.ERRORS,101.7112)
;ITM subscript
D PROCESS(.FDA,.ALIST,.ERRORS,101.71123)
;REQD subscript
D PROCESS(.FDA,.ALIST,.ERRORS,101.714)
I '$D(ERRORS) D UPDATENAT(.FDA) Q
S PXRMDONE=1
D BMES^XPDUTL("Missing data must be corrected before continuing!")
S IDX=0 F S IDX=$O(ERRORS(IDX)) Q:IDX'>0 D
.D BMES^XPDUTL(ERRORS(IDX))
H 2
Q
;
PROCESS(FDA,ALIST,ERRORS,FN) ;
N ECNT,FILE,FLD,IEN,IENS,VALUE
S IENS="" F S IENS=$O(FDA(FN,IENS)) Q:IENS="" D
.S FLD=0 F S FLD=$O(FDA(FN,IENS,FLD)) Q:FLD'>0 D
..S VALUE=$G(FDA(FN,IENS,FLD))
..S FILE=+$G(ALIST(FN,FLD)) I FILE=0,FLD'=11 Q
..S FILE=$S(VALUE["RT.":811.5,VALUE["RD.":811.9,FILE'="":FILE,1:"")
..I FILE="" Q
..I VALUE["RD"!(VALUE["RT") S VALUE=$P(VALUE,".",2)
..S IEN=$$EXISTS^PXRMEXIU(FILE,VALUE)
..I IEN>0 Q
..S ECNT=$O(ERRORS(""),-1)+1,ERRORS(ECNT)="Entry "_VALUE_" missing from file: "_FILE
Q
;
UPDATENAT(FDA) ;
N DA,DESCTXT,DIK,NAME,INPUTS
S NAME=$P($G(^PXD(811.8,PXRMRIEN,0)),U)
I NAME="" D BMES^XPDUTL("Cannot find exchange file name for backup.") H 1 S PXRMDONE=1 Q
S INPUTS(101.71,"NATIONAL")=""
S DESCTXT(1)="Exchange file built when "_NAME
S DESCTXT(2)="was installed on "_$$FMTE^XLFDT($$NOW^XLFDT())
D BMES^XPDUTL("Preparing backup")
D CRE^PXRMEXSP(NAME_" BACKUP",.INPUTS,.DESCTXT,1)
D BMES^XPDUTL("Removing old entries") H 1
S DA=$$GETNATIONAL^ORIUTL I DA=0 Q
S FDA(101.71,"+1,",.03)=$$NOW^XLFDT()
S FDA(101.71,"+1,",.04)=NAME
D SETUPDATING^ORIUTL
H 1
D KILLNATIONAL^ORIUTL
S DIK="^ORI(101.71," D ^DIK
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEXUINFOPNL 2477 printed May 25, 2026@11:48:51 Page 2
PXRMEXUINFOPNL ;SLC/PJH,PKR - Reminder Exchange #4, cprs info panel. ;Jun 10, 2024@11:56:30
+1 ;;2.0;CLINICAL REMINDERS;**87**;Feb 04, 2005;Build 35
+2 ;
+3 ; Reference to SETUPDATING^ORIUTL supported by DBIA # 7465 (submit)
+4 ; Reference to $$GETNATIONAL^ORIUTL supported by DBIA # 7465 (submit)
+5 ; Reference to KILLNATIONAL^ORIUTL supported by DBIA # 7465 (submit)
+6 ;
+7 QUIT
+8 ;
EN(FDA) ;
+1 NEW ALIST,ERRORS,FLD,IDX
+2 SET ALIST(101.7112,.02)=101.73
SET ALIST(101.7112,.05)=101.73
SET ALIST(101.7112,.08)=101.73
+3 SET ALIST(101.71123,.06)=101.73
SET ALIST(101.71123,.08)=101.73
SET ALIST(101.71123,13)=101.73
+4 SET ALIST(101.71123,13)=101.75
SET ALIST(101.71123,23)=101.73
SET ALIST(101.71123,24)=101.73
+5 SET ALIST(101.71123,30)=101.73
SET ALIST(101.71123,32)=101.75
SET ALIST(101.71123,34)=101.74
+6 SET ALIST(191.714,.01)=101.73
+7 ;
+8 ;I $O(FDA(101.71,""))'="+1," D BMES^XPDUTL("Only National Data can be installed.") S PXRMDONE=1 Q
+9 ;LOC subscript
+10 DO PROCESS(.FDA,.ALIST,.ERRORS,101.7112)
+11 ;ITM subscript
+12 DO PROCESS(.FDA,.ALIST,.ERRORS,101.71123)
+13 ;REQD subscript
+14 DO PROCESS(.FDA,.ALIST,.ERRORS,101.714)
+15 IF '$DATA(ERRORS)
DO UPDATENAT(.FDA)
QUIT
+16 SET PXRMDONE=1
+17 DO BMES^XPDUTL("Missing data must be corrected before continuing!")
+18 SET IDX=0
FOR
SET IDX=$ORDER(ERRORS(IDX))
if IDX'>0
QUIT
Begin DoDot:1
+19 DO BMES^XPDUTL(ERRORS(IDX))
End DoDot:1
+20 HANG 2
+21 QUIT
+22 ;
PROCESS(FDA,ALIST,ERRORS,FN) ;
+1 NEW ECNT,FILE,FLD,IEN,IENS,VALUE
+2 SET IENS=""
FOR
SET IENS=$ORDER(FDA(FN,IENS))
if IENS=""
QUIT
Begin DoDot:1
+3 SET FLD=0
FOR
SET FLD=$ORDER(FDA(FN,IENS,FLD))
if FLD'>0
QUIT
Begin DoDot:2
+4 SET VALUE=$GET(FDA(FN,IENS,FLD))
+5 SET FILE=+$GET(ALIST(FN,FLD))
IF FILE=0
IF FLD'=11
QUIT
+6 SET FILE=$SELECT(VALUE["RT.":811.5,VALUE["RD.":811.9,FILE'="":FILE,1:"")
+7 IF FILE=""
QUIT
+8 IF VALUE["RD"!(VALUE["RT")
SET VALUE=$PIECE(VALUE,".",2)
+9 SET IEN=$$EXISTS^PXRMEXIU(FILE,VALUE)
+10 IF IEN>0
QUIT
+11 SET ECNT=$ORDER(ERRORS(""),-1)+1
SET ERRORS(ECNT)="Entry "_VALUE_" missing from file: "_FILE
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
UPDATENAT(FDA) ;
+1 NEW DA,DESCTXT,DIK,NAME,INPUTS
+2 SET NAME=$PIECE($GET(^PXD(811.8,PXRMRIEN,0)),U)
+3 IF NAME=""
DO BMES^XPDUTL("Cannot find exchange file name for backup.")
HANG 1
SET PXRMDONE=1
QUIT
+4 SET INPUTS(101.71,"NATIONAL")=""
+5 SET DESCTXT(1)="Exchange file built when "_NAME
+6 SET DESCTXT(2)="was installed on "_$$FMTE^XLFDT($$NOW^XLFDT())
+7 DO BMES^XPDUTL("Preparing backup")
+8 DO CRE^PXRMEXSP(NAME_" BACKUP",.INPUTS,.DESCTXT,1)
+9 DO BMES^XPDUTL("Removing old entries")
HANG 1
+10 SET DA=$$GETNATIONAL^ORIUTL
IF DA=0
QUIT
+11 SET FDA(101.71,"+1,",.03)=$$NOW^XLFDT()
+12 SET FDA(101.71,"+1,",.04)=NAME
+13 DO SETUPDATING^ORIUTL
+14 HANG 1
+15 DO KILLNATIONAL^ORIUTL
+16 SET DIK="^ORI(101.71,"
DO ^DIK
+17 QUIT
+18 ;
