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

HBHC32EN.m

Go to the documentation of this file. 
  1. HBHC32EN ;HPS/DSK - Pre-install environment check; May 02, 2021@14:20
  1.  ;;1.0;HOSPITAL BASED HOME CARE;**32**;NOV 01, 1993;Build 58
  1.  ;
  1.  ;NEW PERSON (#200) file - IA #10060 (supported)
  1.  ;BMES^XPDUTL            - IA #10141 (supported)
  1.  ;^XUSEC                 - IA #10076 (supported)
  1.  ;
  1. EN ;
  1.  ;Variable XPDQUIT is new'd by XPD routines.
  1.  ;Setting XPDQUIT=2 leaves install in ^XTMP but
  1.  ;aborts install until after issues are resolved.
  1.  D BMES^XPDUTL("*** Environment check starting.... ***")
  1.  N HBHCSEQ
  1.  S HBHCSEQ=5,XPDQUIT=0
  1.  K ^XTMP("HBHC32 ENV CHECK")
  1.  S ^XTMP("HBHC32 ENV CHECK",0)=$$FMADD^XLFDT(DT,60)_"^"_DT_"^HBH*1.0*32 Environment Check"
  1.  D ID,PROV
  1.  S HBHCMZ=$$MESS()
  1.  I $G(HBHCMZ) D
  1.  . D BMES^XPDUTL("*** Environment Check Failed - Install Aborted. ***")
  1.  . D BMES^XPDUTL("MailMan message #"_HBHCMZ_" has been sent to")
  1.  . D BMES^XPDUTL("holders of the HBHC MANAGER security key and")
  1.  . D BMES^XPDUTL("the patch installer "_$P($G(^VA(200,+DUZ,0)),"^")_".")
  1.  ;
  1.  D BMES^XPDUTL("*** Environment check finished. ***")
  1.  Q
  1.  ;
  1. ID ;
  1.  ;First check: are any HBHC ID's assigned to
  1.  ;             more than one active provider.
  1.  N HBHCA,HBHCB,HBHCHIT,HBHCCHK,HBHCNAME,HBHCZ
  1.  S (HBHCA,HBHCB)="",HBHCCHK=0
  1.  F  S HBHCA=$O(^HBHC(631.4,"B",HBHCA)) Q:HBHCA=""  D
  1.  . S HBHCHIT=0
  1.  . F  S HBHCB=$O(^HBHC(631.4,"B",HBHCA,HBHCB)) Q:HBHCB=""  D
  1.  . . Q:$P(^HBHC(631.4,HBHCB,0),"^",7)=1
  1.  . . ;found an active provider
  1.  . . S HBHCHIT=HBHCHIT+1
  1.  . . I HBHCHIT=1 S HBHCZ=HBHCB
  1.  . . Q:HBHCHIT=1
  1.  . . ;generate list for MailMan message
  1.  . . I 'HBHCCHK D
  1.  . . . S HBHCSEQ=HBHCSEQ+1
  1.  . . . S ^XTMP("HBHC32 ENV CHECK",HBHCSEQ)=" "
  1.  . . . S HBHCSEQ=HBHCSEQ+1
  1.  . . . S ^XTMP("HBHC32 ENV CHECK",HBHCSEQ)="HBHC ID's assigned to more than one provider"
  1.  . . . S HBHCSEQ=HBHCSEQ+1
  1.  . . . S ^XTMP("HBHC32 ENV CHECK",HBHCSEQ)="------------------------------------------------------------------"
  1.  . . . S HBHCCHK=1
  1.  . . I HBHCHIT=2 D
  1.  . . . ;If HBHCHIT=2, more than one active provider
  1.  . . . ;is assigned to this ID, and install should be aborted.
  1.  . . . S:'XPDQUIT XPDQUIT=2
  1.  . . . ;retrieve name from first occurrence
  1.  . . . S HBHCNAME=$P(^HBHC(631.4,HBHCZ,0),"^",2)
  1.  . . . S HBHCNAME=$P($G(^VA(200,HBHCNAME,0)),"^")
  1.  . . . S HBHCSEQ=HBHCSEQ+1
  1.  . . . S ^XTMP("HBHC32 ENV CHECK",HBHCSEQ)=HBHCA_$E("      ",1,6-($L(HBHCA)))_HBHCNAME
  1.  . . S HBHCNAME=$P(^HBHC(631.4,HBHCB,0),"^",2)
  1.  . . S HBHCNAME=$P($G(^VA(200,HBHCNAME,0)),"^")
  1.  . . S HBHCSEQ=HBHCSEQ+1
  1.  . . S ^XTMP("HBHC32 ENV CHECK",HBHCSEQ)="      "_HBHCNAME
  1.  Q
  1.  ;
  1. PROV ;
  1.  ;Second check: are any providers assigned to
  1.  ;              more than one active HBHC ID.
  1.  N HBHCA,HBHCB,HBHCHIT,HBHCZ,HBHCCHK,HBHCSPACE,HBHCNAME
  1.  S HBHCSPACE="                                     "
  1.  S (HBHCA,HBHCB)="",HBHCCHK=0
  1.  F  S HBHCA=$O(^HBHC(631.4,"C",HBHCA)) Q:HBHCA=""  D
  1.  . S HBHCHIT=0
  1.  . F  S HBHCB=$O(^HBHC(631.4,"C",HBHCA,HBHCB)) Q:HBHCB=""  D
  1.  . . Q:$P(^HBHC(631.4,HBHCB,0),"^",7)=1
  1.  . . ;found an active provider number
  1.  . . S HBHCHIT=HBHCHIT+1
  1.  . . I HBHCHIT=1 S HBHCZ=HBHCB
  1.  . . Q:HBHCHIT=1
  1.  . . ;generate list for MailMan message
  1.  . . I 'HBHCCHK D
  1.  . . . S HBHCSEQ=HBHCSEQ+1
  1.  . . . S ^XTMP("HBHC32 ENV CHECK",HBHCSEQ)=" "
  1.  . . . S HBHCSEQ=HBHCSEQ+1
  1.  . . . S ^XTMP("HBHC32 ENV CHECK",HBHCSEQ)="Providers assigned to more than one active HBHC ID"
  1.  . . . S HBHCSEQ=HBHCSEQ+1
  1.  . . . S ^XTMP("HBHC32 ENV CHECK",HBHCSEQ)="------------------------------------------------------------------"
  1.  . . . S HBHCCHK=1
  1.  . . I HBHCHIT=2 D
  1.  . . . S HBHCNAME=$P($G(^VA(200,HBHCA,0)),"^")
  1.  . . . S HBHCNAME=HBHCNAME_$E(HBHCSPACE,1,37-$L(HBHCNAME))
  1.  . . . ;If HBHCHIT=2, more than one active ID is assigned to this
  1.  . . . ;provider, and install should be aborted.
  1.  . . . S:'XPDQUIT XPDQUIT=2
  1.  . . . ;pick up the first occurrence
  1.  . . . S HBHCSEQ=HBHCSEQ+1
  1.  . . . S ^XTMP("HBHC32 ENV CHECK",HBHCSEQ)=HBHCNAME_$E(HBHCSPACE,1,(37-$L(HBHCNAME)))_$P(^HBHC(631.4,HBHCZ,0),"^")
  1.  . . S HBHCSEQ=HBHCSEQ+1
  1.  . . S ^XTMP("HBHC32 ENV CHECK",HBHCSEQ)=HBHCSPACE_$P(^HBHC(631.4,HBHCB,0),"^")
  1.  Q
  1.  ;
  1. MESS() ;
  1.  ;Display results of environment check.
  1.  ;Generate MailMan message if issues found.
  1.  N HBHCSUB,HBHCMIN,HBHCTEXT,HBHCDUZ,HBHCMY,HBHCMZ
  1.  S HBHCMZ=0
  1.  I 'XPDQUIT D BMES^XPDUTL("No issues found during environment check.") Q HBHCMZ
  1.  ;
  1.  I XPDQUIT D
  1.  . S HBHCSUB="HBH*1.0*32 Install Failed Environment Check"
  1.  . S HBHCMIN=DUZ
  1.  . S HBHCMY(DUZ)=""
  1.  . S HBHCTEXT="^XTMP(""HBHC32 ENV CHECK"")"
  1.  . S HBHCDUZ=""
  1.  . F  S HBHCDUZ=$O(^XUSEC("HBHC MANAGER",HBHCDUZ)) Q:HBHCDUZ=""  D
  1.  . . S HBHCMY(HBHCDUZ)=""
  1.  . S ^XTMP("HBHC32 ENV CHECK",1)="If this message lists active ID's assigned to more than one provider,"
  1.  . S ^XTMP("HBHC32 ENV CHECK",2)="assign each provider to a unique active ID."
  1.  . S ^XTMP("HBHC32 ENV CHECK",3)=" "
  1.  . S ^XTMP("HBHC32 ENV CHECK",4)="If the message lists providers assigned to more than one active ID,"
  1.  . S ^XTMP("HBHC32 ENV CHECK",5)="inactivate all ID's except one."
  1.  . D SENDMSG^XMXAPI(HBHCDUZ,HBHCSUB,HBHCTEXT,.HBHCMY,.HBHCMIN,.HBHCMZ,"")
  1.  Q HBHCMZ
  1.  ;