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

PXRMEXSP.m

Go to the documentation of this file. 
  1. PXRMEXSP ;SLC/AGP - Auto packed utility. ;Oct 24, 2023@15:37:44
  1.  ;;2.0;CLINICAL REMINDERS;**85**;Feb 04, 2005;Build 7
  1.  ;
  1. TESTER ;
  1.  N DESCTXT,EXNAME,INPUTS,NOTINLM
  1.  S INPUTS(811.9,"VA-WH PAP SMEAR SCREENING")=""
  1.  S INPUTS(811.9,"ZZVA-WH PAP SMEAR REVIEW RESULTS")=""
  1.  S INPUTS(801.41,"VA-WH PAP SMEAR SCREENING")=""
  1.  S INPUTS(801.41,"ZZVA-WH PAP SMEAR REVIEW RESULTS")=""
  1.  S DESCTXT(1)="Exchange file built when patch PXRM*2.0*81"
  1.  S DESCTXT(2)="was installed on "_$$FMTE^XLFDT($$NOW^XLFDT())
  1.  S NOTINLM=1,EXNAME="PXRM*2.0*81 AUTOMATIC BACKUP"
  1.  D CRE(EXNAME,.INPUTS,.DESCTXT,NOTINLM)
  1.  Q
  1.  ;
  1.  ;==========================
  1. BACKUP(IEN) ;
  1.  N DIR,DESCTXT,EXNAME,FAIL,FILES,INPUTS,LIST,NAME,Y
  1.  S NAME=$P($G(^PXD(811.8,IEN,0)),U)
  1.  S DIR(0)="Y",DIR("B")="YES",DIR("A")="Back up selected files"
  1.  D ^DIR
  1.  I +Y'=1 Q
  1.  D FILELIST^PXRMEXRP(.FILES)
  1.  S FAIL=0
  1.  D PROC120^PXRMEXRP(.LIST,.FILES,IEN,.FAIL) I FAIL=1 W !,"Could not backup exchange entry "_NAME H 2 Q
  1.  M INPUTS=LIST("FILES")
  1.  S EXNAME=$S($L(NAME)<55:NAME_" (BACKUP)",1:$E(NAME,1,54)_" (BACKUP)")
  1.  D CRE(EXNAME,.INPUTS,.DESCTXT,0)
  1.  Q
  1.  ;
  1.  ;==========================
  1. BLDDESC(TMPIND,DESCTXT) ;If multiple entries have been selected
  1.  ;then initialize the description with the selected list.
  1.  N IND,NL,NOUT,TEXT,TEXTOUT
  1.  S NL=+$O(DESCTXT(""))+1
  1.  D FORMAT^PXRMTEXT(1,70,NL,.DESCTXT,.NOUT,.TEXTOUT)
  1.  K ^TMP(TMPIND,$J,"DESC")
  1.  F IND=1:1:NOUT  S ^TMP(TMPIND,$J,"DESC",1,IND,0)=TEXTOUT(IND)
  1.  Q
  1.  ;
  1. BLDFSEL(SELLIST,FILELST,INPUTS) ;
  1.  N ERROR,FN,ID,IEN,NUMF
  1.  S FN=0,ERROR=0
  1.  F  S FN=$O(INPUTS(FN)) Q:FN'>0!(ERROR=1)  D
  1.  .S NUMF=0
  1.  .S ID="" F  S ID=$O(INPUTS(FN,ID)) Q:ID=""!(ERROR=1)  D
  1.  .. S IEN=$S(+ID>0:+ID,1:$$EXISTS^PXRMEXIU(FN,ID))
  1.  .. I IEN=0 S ERROR=1 Q
  1.  .. S NUMF=NUMF+1
  1.  .. S SELLIST(FN,NUMF)=IEN
  1.  .. S SELLIST(FN,"IEN",NUMF)=NUMF
  1.  I ERROR=1 Q 0
  1.  Q 1
  1.  ;
  1.  ;==========================
  1. CRE(EXNAME,INPUTS,DESCTXT,NOTINLM) ;Pack a reminder component and store it in the repository.
  1.  N CMPLIST,CNT,DIEN,DERRFND,DERRMSG,EFNAME,ERROR,FAIL,FAILTYPE,FILELST
  1.  N OUTPUT,POA,RANK,SERROR,SELLIST,SUCCESS,TMPIND,USELIST
  1.  S TMPIND="PXRMEXPR"
  1.  K ^TMP(TMPIND,$J)
  1.  D GETFLST(.FILELST)
  1.  D PACKORD^PXRMEXPD(.RANK)
  1.  I '$$BLDFSEL(.SELLIST,.FILELST,.INPUTS) Q
  1.  ;
  1.  K VALMHDR
  1.  I '$D(SELLIST) Q
  1.  ;Save the user's selections.
  1.  M USELIST=SELLIST
  1.  ;Process the selected list to build a complete list of components
  1.  ;to be packed.
  1.  D CMPLIST^PXRMEXPD(.CMPLIST,.SELLIST,.FILELST,.ERROR)
  1.  I ERROR K ^TMP(TMPIND,$J) Q
  1.  S NOTINLM=$G(NOTINLM)
  1.  I '$$DEF(.SELLIST,TMPIND,NOTINLM) Q
  1.  I '$$TERM(.SELLIST,TMPIND,NOTINLM) Q
  1.  I '$$DIALOG(.SELLIST,TMPIND,NOTINLM) Q
  1.  ;
  1.  ;Create the header information.
  1.  S EFNAME=$S($G(EXNAME)'="":EXNAME,1:"")
  1.  S NOTINLM=$G(NOTINLM)
  1.  D HEADER(TMPIND,.USELIST,.SELLIST,.RANK,EXNAME,.DESCTXT)
  1.  I EXNAME=-1 Q
  1.  ;
  1.  ;Order the component list.
  1.  D ORDER^PXRMEXPD(.CMPLIST,.RANK,.POA)
  1.  ;Pack the list
  1.  D PACK^PXRMEXPD(.CMPLIST,.POA,TMPIND,.SELLIST,.SERROR)
  1.  I SERROR K ^TMP(TMPIND,$J) Q
  1.  D STOREPR^PXRMEXU2(.SUCCESS,EXNAME,TMPIND,.SELLIST)
  1.  K ^TMP(TMPIND,$J)
  1.  I SUCCESS D
  1.  . I +$G(NOTINLM) D BMES^XPDUTL(EFNAME_" was saved in the Exchange File.") Q
  1.  . S VALMHDR(1)=EFNAME_" was saved in the Exchange File."
  1.  . D BLDLIST^PXRMEXLC(1)
  1.  E  D
  1.  . I +$G(NOTINLM) D  Q
  1.  ..D BMES^XPDUTL("Creation of Exchange File entry "_EFNAME)
  1.  ..D BMES^XPDUTL("failed; it was not saved!")
  1.  . S VALMHDR(1)="Creation of Exchange File entry "_EFNAME
  1.  . S VALMHDR(2)="failed; it was not saved!"
  1.  Q
  1.  ;
  1. DEF(SELLIST,TMPIND,NOTINLM) ;Check reminder definitions for errors.
  1.  N DIEN,FAIL,IDX,OK,OUTPUT
  1.  S FAIL=0
  1.  I $D(SELLIST(811.9)) D  I FAIL K ^TMP(TMPIND,$J) Q 0
  1.  .;Check each reminder definition.
  1.  . I 'NOTINLM W !!,"Checking reminder definition(s) for errors."
  1.  . S IDX=0
  1.  . F  S IDX=$O(SELLIST(811.9,"IEN",IDX)) Q:IDX'>0  D
  1.  .. S DIEN=+$G(SELLIST(811.9,IDX)) I DIEN=0 Q
  1.  .. I 'NOTINLM W !!,"Checking reminder definition "_$P(^PXD(811.9,DIEN,0),U,1)
  1.  .. K OUTPUT
  1.  .. S OK=$$DEF^PXRMICHK(DIEN,.OUTPUT,$S(NOTINLM=1:0,1:1))
  1.  .. I OK=0 S FAIL=1
  1.  I NOTINLM Q $S(FAIL=1:0,1:1)
  1.  I FAIL=0 W !!,"No fatal reminder definition problems were found, packing will continue."
  1.  I FAIL=1 W !!,"Cannot create the packed file, please correct the above fatal error(s)."
  1.  H 3
  1.  Q 1
  1.  ;
  1. DIALOG(SELLIST,TMPIND,NOTINLM) ;Check reminder dialogs for errors
  1.  N CNT,DIEN,FAIL,IDX,OUTPUT,FAILTYPE
  1.  S FAIL=0
  1.  K OUTPUT
  1.  I $D(SELLIST(801.41)) D  I FAIL="F" K ^TMP(TMPIND,$J) Q 0
  1.  .I 'NOTINLM W !!,"Checking reminder dialog(s) for errors."
  1.  . S IDX=0
  1.  .;Check individual reminder dialogs
  1.  . F  S IDX=$O(SELLIST(801.41,"IEN",IDX)) Q:IDX'>0  D
  1.  .. S DIEN=+$G(SELLIST(801.41,IDX)) I DIEN=0 Q
  1.  .. I FAIL=0 W "."
  1.  .. S FAILTYPE=$$RETARR^PXRMDLRP(DIEN,.OUTPUT) Q:'$D(OUTPUT)
  1.  .. I FAILTYPE="F" S FAIL="F"
  1.  .. I FAILTYPE="W",FAIL=0 S FAIL="W"
  1.  .. I 'NOTINLM D
  1.  ... W !!,$S(FAILTYPE="W":"**WARNING**",FAILTYPE="F":"**FATAL ERROR**",1:"")
  1.  ... S CNT=0 F  S CNT=$O(OUTPUT(CNT)) Q:CNT'>0  W !,OUTPUT(CNT)
  1.  .. K OUTPUT
  1.  .;
  1.  I NOTINLM Q $S(FAIL=1:0,1:1)
  1.  I FAIL=0 W !!,"No fatal dialog problems were found, packing will continue."
  1.  I FAIL="F" W !!,"Cannot create the packed file, please correct the above fatal error(s)."
  1.  H 3
  1.  Q 1
  1.  ;
  1. GETFLST(FILELST) ;
  1.  S FILELST(1)=811.4_U_$$GET1^DID(811.4,"","","NAME")
  1.  S FILELST(2)=810.8_U_$$GET1^DID(810.8,"","","NAME")
  1.  S FILELST(3)=811.9_U_$$GET1^DID(811.9,"","","NAME")
  1.  S FILELST(4)=801.41_U_$$GET1^DID(801.41,"","","NAME")
  1.  S FILELST(5)=810.7_U_$$GET1^DID(810.7,"","","NAME")
  1.  S FILELST(6)=810.2_U_$$GET1^DID(810.2,"","","NAME")
  1.  S FILELST(7)=810.4_U_$$GET1^DID(810.4,"","","NAME")
  1.  S FILELST(8)=810.9_U_$$GET1^DID(810.9,"","","NAME")
  1.  S FILELST(9)=811.3_U_$$GET1^DID(811.3,"","","NAME")
  1.  S FILELST(10)=811.6_U_$$GET1^DID(811.6,"","","NAME")
  1.  S FILELST(11)=811.2_U_$$GET1^DID(811.2,"","","NAME")
  1.  S FILELST(12)=811.5_U_$$GET1^DID(811.5,"","","NAME")
  1.  S FILELST(13)=801_U_$$GET1^DID(801,"","","NAME")
  1.  S FILELST(14)=801.1_U_$$GET1^DID(801.1,"","","NAME")
  1.  S FILELST(0)=14
  1.  Q
  1.  ;
  1.  ;==========================
  1.  ;information.
  1.  ;Save the source information and the passed in description text.
  1.  D PUTSRC^PXRMEXPD("",EFNAME,TMPIND)
  1.  D BLDDESC(TMPIND,.DESCTXT)
  1.  ;Add the packing attributes.
  1.  D PATTR^PXRMEXPD(TMPIND)
  1.  Q
  1.  ;
  1. TERM(SELLIST,TMPIND,NOTINLM) ;Check reminder terms for errors.
  1.  N DIEN,FAIL,IDX,OK,OUTPUT
  1.  S FAIL=0
  1.  I $D(SELLIST(811.5)) D  I FAIL K ^TMP(TMPIND,$J) Q 0
  1.  .;Check each reminder term.
  1.  . I 'NOTINLM W !!,"Checking reminder term(s) for errors."
  1.  . S IDX=0
  1.  . F  S IDX=$O(SELLIST(811.5,"IEN",IDX)) Q:IDX'>0  D
  1.  .. S DIEN=+$G(SELLIST(811.5,IDX)) I DIEN=0 Q
  1.  .. I 'NOTINLM W !!,"Checking reminder term "_$P(^PXRMD(811.5,DIEN,0),U,1)
  1.  .. K OUTPUT
  1.  .. S OK=$$TERM^PXRMICK1(DIEN,.OUTPUT,$S(NOTINLM=1:0,1:1))
  1.  .. I OK=0 S FAIL=1
  1.  I NOTINLM Q $S(FAIL=1:0,1:1)
  1.  I FAIL=0 W !!,"No fatal reminder term problems were found, packing will continue."
  1.  I FAIL=1 W !!,"Cannot create the packed file, please correct the above fatal error(s)."
  1.  H 3
  1.  Q $S(FAIL=1:0,1:1)
  1.  ;