SD53P544 ;ALB/RC - POST-INSTALL SD*5.3*544 ; 8/3/09 11:13am
;;5.3;Scheduling;**544**;Aug 13, 1993;Build 11
Q
EN ;Post install entry point
N SDX,Y
F SDX="POST" D
.S Y=$$NEWCP^XPDUTL(SDX,SDX_"^SD53P544")
.I 'Y D BMES^XPDUTL("ERROR creating "_SDX_" checkpoint.")
Q
POST ;Post-Install
D CLERK
D DEL
Q
CLERK ;Find entries and match up the data entry clerk/time
N SDPT,SDAPPT,SDCLINIC,SDAPTNUM,SDCLK,SDAPDTM,SDIENS
N DA,DIE
I '$D(^XTMP("SD53P544-"_$J,0)) S ^XTMP("SD53P544-"_$J,0)=$$FMADD^XLFDT(""_DT_"",30)_U_DT_U_"Records updated by SD*5.3*544"
S (SDCLK,SDAPDTM)=""
S SDPT=0
F S SDPT=$O(^DPT(SDPT)) Q:SDPT'>0 D
.S SDAPPT=3080930.999999
.F S SDAPPT=$O(^DPT(SDPT,"S",SDAPPT)) Q:SDAPPT'>0 D
..I $P(^DPT(SDPT,"S",SDAPPT,0),"^",18)="" D
...S SDCLINIC=$P(^DPT(SDPT,"S",SDAPPT,0),"^",1),SDAPTNUM=0 Q:SDCLINIC'>0
...F S SDAPTNUM=$O(^SC(SDCLINIC,"S",SDAPPT,1,SDAPTNUM)) Q:SDAPTNUM'>0 D
....I $P($G(^SC(SDCLINIC,"S",SDAPPT,1,SDAPTNUM,0)),"^",1)=SDPT D
.....S SDIENS=""_SDAPTNUM_","_SDAPPT_","_SDCLINIC_","_""
.....S SDCLK=$$GET1^DIQ(44.003,SDIENS,7,"I")
.....S SDAPDTM=$$GET1^DIQ(44.003,SDIENS,8,"I")
.....I $G(SDCLK) S $P(^DPT(SDPT,"S",SDAPPT,0),"^",18)=SDCLK,$P(^XTMP("SD53P544-"_$J,SDPT,SDAPPT),U)=SDCLK
.....I $G(SDAPDTM) S $P(^DPT(SDPT,"S",SDAPPT,0),"^",19)=SDAPDTM,$P(^XTMP("SD53P544-"_$J,SDPT,SDAPPT),U,2)=SDAPDTM
Q
DEL ;
N DIK,DA
Q:'$D(^DD(2.011,1.5)) ;Quit if global doesn't exist.
S DIK="^DD(2.011,",DA=1.5,DA(1)=2
D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53P544 1498 printed Dec 13, 2024@02:46:30 Page 2
SD53P544 ;ALB/RC - POST-INSTALL SD*5.3*544 ; 8/3/09 11:13am
+1 ;;5.3;Scheduling;**544**;Aug 13, 1993;Build 11
+2 QUIT
EN ;Post install entry point
+1 NEW SDX,Y
+2 FOR SDX="POST"
Begin DoDot:1
+3 SET Y=$$NEWCP^XPDUTL(SDX,SDX_"^SD53P544")
+4 IF 'Y
DO BMES^XPDUTL("ERROR creating "_SDX_" checkpoint.")
End DoDot:1
+5 QUIT
POST ;Post-Install
+1 DO CLERK
+2 DO DEL
+3 QUIT
CLERK ;Find entries and match up the data entry clerk/time
+1 NEW SDPT,SDAPPT,SDCLINIC,SDAPTNUM,SDCLK,SDAPDTM,SDIENS
+2 NEW DA,DIE
+3 IF '$DATA(^XTMP("SD53P544-"_$JOB,0))
SET ^XTMP("SD53P544-"_$JOB,0)=$$FMADD^XLFDT(""_DT_"",30)_U_DT_U_"Records updated by SD*5.3*544"
+4 SET (SDCLK,SDAPDTM)=""
+5 SET SDPT=0
+6 FOR
SET SDPT=$ORDER(^DPT(SDPT))
if SDPT'>0
QUIT
Begin DoDot:1
+7 SET SDAPPT=3080930.999999
+8 FOR
SET SDAPPT=$ORDER(^DPT(SDPT,"S",SDAPPT))
if SDAPPT'>0
QUIT
Begin DoDot:2
+9 IF $PIECE(^DPT(SDPT,"S",SDAPPT,0),"^",18)=""
Begin DoDot:3
+10 SET SDCLINIC=$PIECE(^DPT(SDPT,"S",SDAPPT,0),"^",1)
SET SDAPTNUM=0
if SDCLINIC'>0
QUIT
+11 FOR
SET SDAPTNUM=$ORDER(^SC(SDCLINIC,"S",SDAPPT,1,SDAPTNUM))
if SDAPTNUM'>0
QUIT
Begin DoDot:4
+12 IF $PIECE($GET(^SC(SDCLINIC,"S",SDAPPT,1,SDAPTNUM,0)),"^",1)=SDPT
Begin DoDot:5
+13 SET SDIENS=""_SDAPTNUM_","_SDAPPT_","_SDCLINIC_","_""
+14 SET SDCLK=$$GET1^DIQ(44.003,SDIENS,7,"I")
+15 SET SDAPDTM=$$GET1^DIQ(44.003,SDIENS,8,"I")
+16 IF $GET(SDCLK)
SET $PIECE(^DPT(SDPT,"S",SDAPPT,0),"^",18)=SDCLK
SET $PIECE(^XTMP("SD53P544-"_$JOB,SDPT,SDAPPT),U)=SDCLK
+17 IF $GET(SDAPDTM)
SET $PIECE(^DPT(SDPT,"S",SDAPPT,0),"^",19)=SDAPDTM
SET $PIECE(^XTMP("SD53P544-"_$JOB,SDPT,SDAPPT),U,2)=SDAPDTM
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 QUIT
DEL ;
+1 NEW DIK,DA
+2 ;Quit if global doesn't exist.
if '$DATA(^DD(2.011,1.5))
QUIT
+3 SET DIK="^DD(2.011,"
SET DA=1.5
SET DA(1)=2
+4 DO ^DIK
+5 QUIT
