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

DGPREPST.m

Go to the documentation of this file.
  1. DGPREPST ;ALB/SCK - Pre-Registration Post Init ; 1/9/97
  1. ;;5.3;Regisitration;**109**;Aug 13, 1993
  1. ;
  1. START ;
  1. D BMES^XPDUTL("Beginning Post-Install of Pre-Registration")
  1. ;
  1. I '$$NEWCP^XPDUTL("POST_1","OPT1^DGPREPST",0) D
  1. . D BMES^XPDUTL("Error creating Scheduling Option checkpoint")
  1. ;
  1. I '$$NEWCP^XPDUTL("POST_2","OPT2^DGPREPST",0) D
  1. . D BMES^XPDUTL("Error adding to Mailgroup checkpoint")
  1. ;
  1. D BMES^XPDUTL("Post-Install Complete")
  1. Q
  1. ;
  1. OPT1 ;
  1. N DGPIEN,DGPIEN1,MSG,DIFROM,DGPERR
  1. ;
  1. S DGPIEN="",DGPIEN=$O(^DIC(19,"B","DGPRE PRE-REGISTER NIGHT JOB",DGPIEN))
  1. I DGPIEN']"" D Q
  1. . S MSG(1)="The DGPRE PRE-REGISTER NIGHT JOB option was not created in the OPTION File"
  1. . S MSG(2)="during the KIDS build. Please re-verify your KIDS build and reinstall"
  1. . D MES^XPDUTL(.MSG) K MSG
  1. ;
  1. S (DGPF,DGPIEN1)="",DGPIEN1=$O(^DIC(19.2,"B",DGPIEN,DGPIEN1))
  1. S:DGPIEN1']"" DGPF="L"
  1. ;
  1. I DGPIEN1]"",+$P($G(^DIC(19.2,DGPIEN1,0)),U,2)>0 S Y=$P(^(0),U,2) D Q
  1. . D BMES^XPDUTL("The DGPRE PRE-REGISTER NIGHT JOB is already scheduled for"_$$FMTE^XLFDT(Y))
  1. ;
  1. I XPDQUES("POS001")']"" D
  1. . S MSG(1)="You have not specified the QUEUED TO RUN AT WHAT TIME"
  1. . S MSG(2)="The option will not run until IRM sets the Queued to run time."
  1. . D MES^XPDUTL(.MSG) K MSG
  1. ;
  1. I XPDQUES("POS002")']"" D
  1. . S MSG(1)="You have not specified a DEVICE FOR QUEUED JOB OUTPUT"
  1. . S MSG(2)="This may cause a problem for MSM sites, and a NULL device may have"
  1. . S MSG(3)="to set by IRM"
  1. . D MES^XPDUTL(.MSG) K MSG
  1. ;
  1. D RESCH^XUTMOPT("DGPRE PRE-REGISTER NIGHT JOB",XPDQUES("POS001"),$P(XPDQUES("POS002"),U,2),"1D",DGPF)
  1. S DGPIEN="",DGPIEN=$O(^DIC(19,"B","DGPRE PRE-REGISTER NIGHT JOB",DGPIEN))
  1. S DGPIEN1="",DGPIEN1=$O(^DIC(19.2,"B",DGPIEN,DGPIEN1))
  1. I +$G(DGPIEN1)'>0 D Q
  1. . S MSG(1)="There was an error scheduling the DGPRE PRE-REGISTER NIGHT JOB"
  1. . S MSG(2)="Please have IRM schedule this job in the OPTION SCHEDULING File"
  1. . D MES^XPDUTL(.MSG) K MSG
  1. Q
  1. ;
  1. OPT2 ;
  1. N MSG,DGPIEN,DGPMBR
  1. ;
  1. S DIC="^XMB(3.8,",DIC(0)="MZ",X="DGPRE PRE-REG STAFF" D ^DIC
  1. S DGPIEN=+Y
  1. I DGPIEN'>0 D Q
  1. . S MSG(1)="The DGPRE PRE-REG STAFF mailgroup was not created during the build"
  1. . S MSG(2)="Please check and try re-installing the build. If this still does"
  1. . S MSG(3)="not install correctly, your IRM will have to complete this manually"
  1. . D MES^XPDUTL(.MSG) K MSG
  1. ;
  1. I $G(XPDQUES("POS003"))']"" D Q
  1. . D BMES^XPDUTL("No members selected to add to mailgroup")
  1. ;
  1. S DIC="^XMB(3.8,",DIC(0)="MZ",X="DGPRE PRE-REG STAFF" D ^DIC
  1. ;
  1. S X=$P(XPDQUES("POS003"),U,2)
  1. S DA(1)=DGPIEN,DIC=DIC_DA(1)_",1,",DIC(0)="LQ"
  1. S DIC("P")=$P(^DD(3.8,2,0),"^",2)
  1. ;
  1. D ^DIC K DIC
  1. I +$P(Y,U,3)>0 D G OPT2Q
  1. . D BMES^XPDUTL("Selected member was added to the mailgroup")
  1. ;
  1. I +$P(Y,U,3)=0 D G OPT2Q
  1. . D BMES^XPDUTL("Selected member is already assigned to the mailgroup")
  1. ;
  1. I +$Y<0 D G OPT2Q
  1. . D BMES^XPDUTL("Selected member was not added, contact your IRM")
  1. ;
  1. OPT2Q Q
  1. ;
  1. CNVRT ; Conversion procedure for converting pre-reg fields in the PATIENT File, #2 to
  1. ; the PRE-REGISTRATION AUDIT File, #41.41. This procedure uses the 'AZZ'
  1. ; cross reference in the PATIENT File, #2.
  1. ;
  1. N DGPDT,DGPDFN,DGPD,DGPCNT,DGPCNT1,DGPD1
  1. ;
  1. S (DGPCNT,DGPCNT1)=0
  1. W !!,"Starting conversion of Preregistration entries..."
  1. D WAIT^DICD
  1. S DGPDFN=0 F S DGPDFN=$O(^DPT(DGPDFN)) Q:'DGPDFN D
  1. . S DGPCNT=DGPCNT+1
  1. . I DGPCNT#500=0 W "."
  1. . Q:'$D(^DPT(DGPDFN,663201))
  1. . K DGPD,DGPD1
  1. . S DGPD=$G(^DPT(DGPDFN,663201)),DGPD1=$P(DGPD,U) Q:+DGPD1'>0
  1. . Q:$D(^DGS(41.41,"ADC",DGPDFN,DGPD1))
  1. . K DD,DO
  1. . S DIC="^DGS(41.41,",DIC(0)="NL"
  1. . S X=DGPDFN
  1. . S DIC("DR")="1////^S X=DGPD1;2///^S X=$S($P(DGPD,U,2)]"""":$P(DGPD,U,2),1:.5)"
  1. . D FILE^DICN
  1. . I Y<0 W !,"PROBLEM ADDING DFN: "_DGPDFN_" TO FILE 41.41" Q
  1. . S DGPCNT1=DGPCNT1+1
  1. ;
  1. W !!,"Conversion complete"
  1. W !,DGPCNT_" Patient records scanned"
  1. W !,DGPCNT1_" Records added to File #41.41"
  1. Q