SD53P530 ;ALB/TH - SD*5.3*530 POST INIT; 05/22/08
;;5.3;SCHEDULING;**530**;AUG 13, 1993;Build 8
;
;This routine updates:
; 1. TYPE SCREEN field (#7) for PERF MONITOR DATE SIGNED (PMDT)
; 2. TYPE WHERE field (#6) for PERF MONITOR ACCEPTABLE
; PROVIDER (PMPR)
;in the ACRP REPORT TEMPLATE PARAMETER file (#409.92).
Q
;
POST ;$O thru minor category
; Update field 7 for PMDT in 409.92
D BDT
S OK=0
S MC=0 F S MC=$O(^SD(409.92,"C",MC)) Q:MC="" D
. I MC["DATE SIGNED" D
. . S D0=0 F S D0=$O(^SD(409.92,"C",MC,D0)) Q:D0="" D
. . . I $G(^SD(409.92,D0,8))="" D UPDATE
D ADT
K MC,D0,OK
;
; Update field 6 for PMPR in 409.92
D BPR
S POP=0
S PRMC=0 F S PRMC=$O(^SD(409.92,"C",PRMC)) Q:PRMC="" D
. I PRMC["ACCEPTABLE PROVIDER" D
. . S PRD0=0 F S PRD0=$O(^SD(409.92,"C",PRMC,PRD0)) Q:PRD0="" D
. . . I $E($G(^SD(409.92,PRD0,7)),1)=" " D UPDATE1
D APR
K POP,PRMC,PRD0
Q
;
BDT ; Before update message
N DA,DR,DIE,TYPSCR
N SDA
S SDA(1)=""
S SDA(2)=">>> This installation will update the TYPE SCREEN field (#7)"
S SDA(3)=" for PERF MONITOR DATE SIGNED (PMDT) in the ACRP REPORT"
S SDA(4)=" TEMPLATE PARAMETER file (#409.92)."
S SDA(5)=""
D ATADDQ
Q
;
UPDATE ; Update ACRP REPORT TEMPLATE PARAMETER file #409.92, field #7.
S DA=D0
S TYPSCR="DO^2971001:DT:EPX"
S DR="7///^S X=TYPSCR"
S DIE="^SD(409.92,"
D ^DIE
S OK=1
Q
;
ADT ; After update message
N SDA
S SDA(1)=""
I OK S SDA(2)=">>> TYPE SCREEN field (#7) updated successfully."
I 'OK D
. S SDA(2)=">>> The value for DATE SIGNED is correct. "
. S SDA(2)=SDA(2)_"No change done."
S SDA(3)=""
D ATADDQ
Q
;
BPR ; Before update message
N DA,DR,DIE,TYPWHERE
N SDA
S SDA(1)=""
S SDA(2)=">>> This installation will remove the extra space for the TYPE WHERE field (#6)"
S SDA(3)=" for PERF MONITOR ACCEPTABLE PROVIDER (PMPR) in the ACRP REPORT"
S SDA(4)=" TEMPLATE PARAMETER file (#409.92)."
S SDA(5)=""
D ATADDQ
Q
;
UPDATE1 ; Update ACRP REPORT TEMPLATE PARAMETER file #409.92, field #6.
S DA=PRD0
S TYPWHERE="^VA(200,"
S DR="6////^S X=TYPWHERE"
S DIE="^SD(409.92,"
D ^DIE
S POP=1
Q
;
APR ; After update message
N SDA
S SDA(1)=""
I POP S SDA(2)=">>> TYPE WHERE field (#6) updated successfully."
I 'POP D
.S SDA(2)=">>> The value for ACCEPTABLE PROVIDER is correct. "
.S SDA(2)=SDA(2)_"No change done."
S SDA(3)=""
D ATADDQ
Q
;
ATADDQ ; Display message
D MES^XPDUTL(.SDA)
K SDA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53P530 2516 printed Apr 09, 2024@21:56:54 Page 2
SD53P530 ;ALB/TH - SD*5.3*530 POST INIT; 05/22/08
+1 ;;5.3;SCHEDULING;**530**;AUG 13, 1993;Build 8
+2 ;
+3 ;This routine updates:
+4 ; 1. TYPE SCREEN field (#7) for PERF MONITOR DATE SIGNED (PMDT)
+5 ; 2. TYPE WHERE field (#6) for PERF MONITOR ACCEPTABLE
+6 ; PROVIDER (PMPR)
+7 ;in the ACRP REPORT TEMPLATE PARAMETER file (#409.92).
+8 QUIT
+9 ;
POST ;$O thru minor category
+1 ; Update field 7 for PMDT in 409.92
+2 DO BDT
+3 SET OK=0
+4 SET MC=0
FOR
SET MC=$ORDER(^SD(409.92,"C",MC))
if MC=""
QUIT
Begin DoDot:1
+5 IF MC["DATE SIGNED"
Begin DoDot:2
+6 SET D0=0
FOR
SET D0=$ORDER(^SD(409.92,"C",MC,D0))
if D0=""
QUIT
Begin DoDot:3
+7 IF $GET(^SD(409.92,D0,8))=""
DO UPDATE
End DoDot:3
End DoDot:2
End DoDot:1
+8 DO ADT
+9 KILL MC,D0,OK
+10 ;
+11 ; Update field 6 for PMPR in 409.92
+12 DO BPR
+13 SET POP=0
+14 SET PRMC=0
FOR
SET PRMC=$ORDER(^SD(409.92,"C",PRMC))
if PRMC=""
QUIT
Begin DoDot:1
+15 IF PRMC["ACCEPTABLE PROVIDER"
Begin DoDot:2
+16 SET PRD0=0
FOR
SET PRD0=$ORDER(^SD(409.92,"C",PRMC,PRD0))
if PRD0=""
QUIT
Begin DoDot:3
+17 IF $EXTRACT($GET(^SD(409.92,PRD0,7)),1)=" "
DO UPDATE1
End DoDot:3
End DoDot:2
End DoDot:1
+18 DO APR
+19 KILL POP,PRMC,PRD0
+20 QUIT
+21 ;
BDT ; Before update message
+1 NEW DA,DR,DIE,TYPSCR
+2 NEW SDA
+3 SET SDA(1)=""
+4 SET SDA(2)=">>> This installation will update the TYPE SCREEN field (#7)"
+5 SET SDA(3)=" for PERF MONITOR DATE SIGNED (PMDT) in the ACRP REPORT"
+6 SET SDA(4)=" TEMPLATE PARAMETER file (#409.92)."
+7 SET SDA(5)=""
+8 DO ATADDQ
+9 QUIT
+10 ;
UPDATE ; Update ACRP REPORT TEMPLATE PARAMETER file #409.92, field #7.
+1 SET DA=D0
+2 SET TYPSCR="DO^2971001:DT:EPX"
+3 SET DR="7///^S X=TYPSCR"
+4 SET DIE="^SD(409.92,"
+5 DO ^DIE
+6 SET OK=1
+7 QUIT
+8 ;
ADT ; After update message
+1 NEW SDA
+2 SET SDA(1)=""
+3 IF OK
SET SDA(2)=">>> TYPE SCREEN field (#7) updated successfully."
+4 IF 'OK
Begin DoDot:1
+5 SET SDA(2)=">>> The value for DATE SIGNED is correct. "
+6 SET SDA(2)=SDA(2)_"No change done."
End DoDot:1
+7 SET SDA(3)=""
+8 DO ATADDQ
+9 QUIT
+10 ;
BPR ; Before update message
+1 NEW DA,DR,DIE,TYPWHERE
+2 NEW SDA
+3 SET SDA(1)=""
+4 SET SDA(2)=">>> This installation will remove the extra space for the TYPE WHERE field (#6)"
+5 SET SDA(3)=" for PERF MONITOR ACCEPTABLE PROVIDER (PMPR) in the ACRP REPORT"
+6 SET SDA(4)=" TEMPLATE PARAMETER file (#409.92)."
+7 SET SDA(5)=""
+8 DO ATADDQ
+9 QUIT
+10 ;
UPDATE1 ; Update ACRP REPORT TEMPLATE PARAMETER file #409.92, field #6.
+1 SET DA=PRD0
+2 SET TYPWHERE="^VA(200,"
+3 SET DR="6////^S X=TYPWHERE"
+4 SET DIE="^SD(409.92,"
+5 DO ^DIE
+6 SET POP=1
+7 QUIT
+8 ;
APR ; After update message
+1 NEW SDA
+2 SET SDA(1)=""
+3 IF POP
SET SDA(2)=">>> TYPE WHERE field (#6) updated successfully."
+4 IF 'POP
Begin DoDot:1
+5 SET SDA(2)=">>> The value for ACCEPTABLE PROVIDER is correct. "
+6 SET SDA(2)=SDA(2)_"No change done."
End DoDot:1
+7 SET SDA(3)=""
+8 DO ATADDQ
+9 QUIT
+10 ;
ATADDQ ; Display message
+1 DO MES^XPDUTL(.SDA)
+2 KILL SDA
+3 QUIT
