- DGPREPST ;ALB/SCK - Pre-Registration Post Init ; 1/9/97
- ;;5.3;Regisitration;**109**;Aug 13, 1993
- ;
- START ;
- D BMES^XPDUTL("Beginning Post-Install of Pre-Registration")
- ;
- I '$$NEWCP^XPDUTL("POST_1","OPT1^DGPREPST",0) D
- . D BMES^XPDUTL("Error creating Scheduling Option checkpoint")
- ;
- I '$$NEWCP^XPDUTL("POST_2","OPT2^DGPREPST",0) D
- . D BMES^XPDUTL("Error adding to Mailgroup checkpoint")
- ;
- D BMES^XPDUTL("Post-Install Complete")
- Q
- ;
- OPT1 ;
- N DGPIEN,DGPIEN1,MSG,DIFROM,DGPERR
- ;
- S DGPIEN="",DGPIEN=$O(^DIC(19,"B","DGPRE PRE-REGISTER NIGHT JOB",DGPIEN))
- I DGPIEN']"" D Q
- . S MSG(1)="The DGPRE PRE-REGISTER NIGHT JOB option was not created in the OPTION File"
- . S MSG(2)="during the KIDS build. Please re-verify your KIDS build and reinstall"
- . D MES^XPDUTL(.MSG) K MSG
- ;
- S (DGPF,DGPIEN1)="",DGPIEN1=$O(^DIC(19.2,"B",DGPIEN,DGPIEN1))
- S:DGPIEN1']"" DGPF="L"
- ;
- I DGPIEN1]"",+$P($G(^DIC(19.2,DGPIEN1,0)),U,2)>0 S Y=$P(^(0),U,2) D Q
- . D BMES^XPDUTL("The DGPRE PRE-REGISTER NIGHT JOB is already scheduled for"_$$FMTE^XLFDT(Y))
- ;
- I XPDQUES("POS001")']"" D
- . S MSG(1)="You have not specified the QUEUED TO RUN AT WHAT TIME"
- . S MSG(2)="The option will not run until IRM sets the Queued to run time."
- . D MES^XPDUTL(.MSG) K MSG
- ;
- I XPDQUES("POS002")']"" D
- . S MSG(1)="You have not specified a DEVICE FOR QUEUED JOB OUTPUT"
- . S MSG(2)="This may cause a problem for MSM sites, and a NULL device may have"
- . S MSG(3)="to set by IRM"
- . D MES^XPDUTL(.MSG) K MSG
- ;
- D RESCH^XUTMOPT("DGPRE PRE-REGISTER NIGHT JOB",XPDQUES("POS001"),$P(XPDQUES("POS002"),U,2),"1D",DGPF)
- S DGPIEN="",DGPIEN=$O(^DIC(19,"B","DGPRE PRE-REGISTER NIGHT JOB",DGPIEN))
- S DGPIEN1="",DGPIEN1=$O(^DIC(19.2,"B",DGPIEN,DGPIEN1))
- I +$G(DGPIEN1)'>0 D Q
- . S MSG(1)="There was an error scheduling the DGPRE PRE-REGISTER NIGHT JOB"
- . S MSG(2)="Please have IRM schedule this job in the OPTION SCHEDULING File"
- . D MES^XPDUTL(.MSG) K MSG
- Q
- ;
- OPT2 ;
- N MSG,DGPIEN,DGPMBR
- ;
- S DIC="^XMB(3.8,",DIC(0)="MZ",X="DGPRE PRE-REG STAFF" D ^DIC
- S DGPIEN=+Y
- I DGPIEN'>0 D Q
- . S MSG(1)="The DGPRE PRE-REG STAFF mailgroup was not created during the build"
- . S MSG(2)="Please check and try re-installing the build. If this still does"
- . S MSG(3)="not install correctly, your IRM will have to complete this manually"
- . D MES^XPDUTL(.MSG) K MSG
- ;
- I $G(XPDQUES("POS003"))']"" D Q
- . D BMES^XPDUTL("No members selected to add to mailgroup")
- ;
- S DIC="^XMB(3.8,",DIC(0)="MZ",X="DGPRE PRE-REG STAFF" D ^DIC
- ;
- S X=$P(XPDQUES("POS003"),U,2)
- S DA(1)=DGPIEN,DIC=DIC_DA(1)_",1,",DIC(0)="LQ"
- S DIC("P")=$P(^DD(3.8,2,0),"^",2)
- ;
- D ^DIC K DIC
- I +$P(Y,U,3)>0 D G OPT2Q
- . D BMES^XPDUTL("Selected member was added to the mailgroup")
- ;
- I +$P(Y,U,3)=0 D G OPT2Q
- . D BMES^XPDUTL("Selected member is already assigned to the mailgroup")
- ;
- I +$Y<0 D G OPT2Q
- . D BMES^XPDUTL("Selected member was not added, contact your IRM")
- ;
- OPT2Q Q
- ;
- CNVRT ; Conversion procedure for converting pre-reg fields in the PATIENT File, #2 to
- ; the PRE-REGISTRATION AUDIT File, #41.41. This procedure uses the 'AZZ'
- ; cross reference in the PATIENT File, #2.
- ;
- N DGPDT,DGPDFN,DGPD,DGPCNT,DGPCNT1,DGPD1
- ;
- S (DGPCNT,DGPCNT1)=0
- W !!,"Starting conversion of Preregistration entries..."
- D WAIT^DICD
- S DGPDFN=0 F S DGPDFN=$O(^DPT(DGPDFN)) Q:'DGPDFN D
- . S DGPCNT=DGPCNT+1
- . I DGPCNT#500=0 W "."
- . Q:'$D(^DPT(DGPDFN,663201))
- . K DGPD,DGPD1
- . S DGPD=$G(^DPT(DGPDFN,663201)),DGPD1=$P(DGPD,U) Q:+DGPD1'>0
- . Q:$D(^DGS(41.41,"ADC",DGPDFN,DGPD1))
- . K DD,DO
- . S DIC="^DGS(41.41,",DIC(0)="NL"
- . S X=DGPDFN
- . S DIC("DR")="1////^S X=DGPD1;2///^S X=$S($P(DGPD,U,2)]"""":$P(DGPD,U,2),1:.5)"
- . D FILE^DICN
- . I Y<0 W !,"PROBLEM ADDING DFN: "_DGPDFN_" TO FILE 41.41" Q
- . S DGPCNT1=DGPCNT1+1
- ;
- W !!,"Conversion complete"
- W !,DGPCNT_" Patient records scanned"
- W !,DGPCNT1_" Records added to File #41.41"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPREPST 3988 printed Feb 19, 2025@00:17:10 Page 2
- DGPREPST ;ALB/SCK - Pre-Registration Post Init ; 1/9/97
- +1 ;;5.3;Regisitration;**109**;Aug 13, 1993
- +2 ;
- START ;
- +1 DO BMES^XPDUTL("Beginning Post-Install of Pre-Registration")
- +2 ;
- +3 IF '$$NEWCP^XPDUTL("POST_1","OPT1^DGPREPST",0)
- Begin DoDot:1
- +4 DO BMES^XPDUTL("Error creating Scheduling Option checkpoint")
- End DoDot:1
- +5 ;
- +6 IF '$$NEWCP^XPDUTL("POST_2","OPT2^DGPREPST",0)
- Begin DoDot:1
- +7 DO BMES^XPDUTL("Error adding to Mailgroup checkpoint")
- End DoDot:1
- +8 ;
- +9 DO BMES^XPDUTL("Post-Install Complete")
- +10 QUIT
- +11 ;
- OPT1 ;
- +1 NEW DGPIEN,DGPIEN1,MSG,DIFROM,DGPERR
- +2 ;
- +3 SET DGPIEN=""
- SET DGPIEN=$ORDER(^DIC(19,"B","DGPRE PRE-REGISTER NIGHT JOB",DGPIEN))
- +4 IF DGPIEN']""
- Begin DoDot:1
- +5 SET MSG(1)="The DGPRE PRE-REGISTER NIGHT JOB option was not created in the OPTION File"
- +6 SET MSG(2)="during the KIDS build. Please re-verify your KIDS build and reinstall"
- +7 DO MES^XPDUTL(.MSG)
- KILL MSG
- End DoDot:1
- QUIT
- +8 ;
- +9 SET (DGPF,DGPIEN1)=""
- SET DGPIEN1=$ORDER(^DIC(19.2,"B",DGPIEN,DGPIEN1))
- +10 if DGPIEN1']""
- SET DGPF="L"
- +11 ;
- +12 IF DGPIEN1]""
- IF +$PIECE($GET(^DIC(19.2,DGPIEN1,0)),U,2)>0
- SET Y=$PIECE(^(0),U,2)
- Begin DoDot:1
- +13 DO BMES^XPDUTL("The DGPRE PRE-REGISTER NIGHT JOB is already scheduled for"_$$FMTE^XLFDT(Y))
- End DoDot:1
- QUIT
- +14 ;
- +15 IF XPDQUES("POS001")']""
- Begin DoDot:1
- +16 SET MSG(1)="You have not specified the QUEUED TO RUN AT WHAT TIME"
- +17 SET MSG(2)="The option will not run until IRM sets the Queued to run time."
- +18 DO MES^XPDUTL(.MSG)
- KILL MSG
- End DoDot:1
- +19 ;
- +20 IF XPDQUES("POS002")']""
- Begin DoDot:1
- +21 SET MSG(1)="You have not specified a DEVICE FOR QUEUED JOB OUTPUT"
- +22 SET MSG(2)="This may cause a problem for MSM sites, and a NULL device may have"
- +23 SET MSG(3)="to set by IRM"
- +24 DO MES^XPDUTL(.MSG)
- KILL MSG
- End DoDot:1
- +25 ;
- +26 DO RESCH^XUTMOPT("DGPRE PRE-REGISTER NIGHT JOB",XPDQUES("POS001"),$PIECE(XPDQUES("POS002"),U,2),"1D",DGPF)
- +27 SET DGPIEN=""
- SET DGPIEN=$ORDER(^DIC(19,"B","DGPRE PRE-REGISTER NIGHT JOB",DGPIEN))
- +28 SET DGPIEN1=""
- SET DGPIEN1=$ORDER(^DIC(19.2,"B",DGPIEN,DGPIEN1))
- +29 IF +$GET(DGPIEN1)'>0
- Begin DoDot:1
- +30 SET MSG(1)="There was an error scheduling the DGPRE PRE-REGISTER NIGHT JOB"
- +31 SET MSG(2)="Please have IRM schedule this job in the OPTION SCHEDULING File"
- +32 DO MES^XPDUTL(.MSG)
- KILL MSG
- End DoDot:1
- QUIT
- +33 QUIT
- +34 ;
- OPT2 ;
- +1 NEW MSG,DGPIEN,DGPMBR
- +2 ;
- +3 SET DIC="^XMB(3.8,"
- SET DIC(0)="MZ"
- SET X="DGPRE PRE-REG STAFF"
- DO ^DIC
- +4 SET DGPIEN=+Y
- +5 IF DGPIEN'>0
- Begin DoDot:1
- +6 SET MSG(1)="The DGPRE PRE-REG STAFF mailgroup was not created during the build"
- +7 SET MSG(2)="Please check and try re-installing the build. If this still does"
- +8 SET MSG(3)="not install correctly, your IRM will have to complete this manually"
- +9 DO MES^XPDUTL(.MSG)
- KILL MSG
- End DoDot:1
- QUIT
- +10 ;
- +11 IF $GET(XPDQUES("POS003"))']""
- Begin DoDot:1
- +12 DO BMES^XPDUTL("No members selected to add to mailgroup")
- End DoDot:1
- QUIT
- +13 ;
- +14 SET DIC="^XMB(3.8,"
- SET DIC(0)="MZ"
- SET X="DGPRE PRE-REG STAFF"
- DO ^DIC
- +15 ;
- +16 SET X=$PIECE(XPDQUES("POS003"),U,2)
- +17 SET DA(1)=DGPIEN
- SET DIC=DIC_DA(1)_",1,"
- SET DIC(0)="LQ"
- +18 SET DIC("P")=$PIECE(^DD(3.8,2,0),"^",2)
- +19 ;
- +20 DO ^DIC
- KILL DIC
- +21 IF +$PIECE(Y,U,3)>0
- Begin DoDot:1
- +22 DO BMES^XPDUTL("Selected member was added to the mailgroup")
- End DoDot:1
- GOTO OPT2Q
- +23 ;
- +24 IF +$PIECE(Y,U,3)=0
- Begin DoDot:1
- +25 DO BMES^XPDUTL("Selected member is already assigned to the mailgroup")
- End DoDot:1
- GOTO OPT2Q
- +26 ;
- +27 IF +$Y<0
- Begin DoDot:1
- +28 DO BMES^XPDUTL("Selected member was not added, contact your IRM")
- End DoDot:1
- GOTO OPT2Q
- +29 ;
- OPT2Q QUIT
- +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'
- +2 ; cross reference in the PATIENT File, #2.
- +3 ;
- +4 NEW DGPDT,DGPDFN,DGPD,DGPCNT,DGPCNT1,DGPD1
- +5 ;
- +6 SET (DGPCNT,DGPCNT1)=0
- +7 WRITE !!,"Starting conversion of Preregistration entries..."
- +8 DO WAIT^DICD
- +9 SET DGPDFN=0
- FOR
- SET DGPDFN=$ORDER(^DPT(DGPDFN))
- if 'DGPDFN
- QUIT
- Begin DoDot:1
- +10 SET DGPCNT=DGPCNT+1
- +11 IF DGPCNT#500=0
- WRITE "."
- +12 if '$DATA(^DPT(DGPDFN,663201))
- QUIT
- +13 KILL DGPD,DGPD1
- +14 SET DGPD=$GET(^DPT(DGPDFN,663201))
- SET DGPD1=$PIECE(DGPD,U)
- if +DGPD1'>0
- QUIT
- +15 if $DATA(^DGS(41.41,"ADC",DGPDFN,DGPD1))
- QUIT
- +16 KILL DD,DO
- +17 SET DIC="^DGS(41.41,"
- SET DIC(0)="NL"
- +18 SET X=DGPDFN
- +19 SET DIC("DR")="1////^S X=DGPD1;2///^S X=$S($P(DGPD,U,2)]"""":$P(DGPD,U,2),1:.5)"
- +20 DO FILE^DICN
- +21 IF Y<0
- WRITE !,"PROBLEM ADDING DFN: "_DGPDFN_" TO FILE 41.41"
- QUIT
- +22 SET DGPCNT1=DGPCNT1+1
- End DoDot:1
- +23 ;
- +24 WRITE !!,"Conversion complete"
- +25 WRITE !,DGPCNT_" Patient records scanned"
- +26 WRITE !,DGPCNT1_" Records added to File #41.41"
- +27 QUIT