- SD53P530 ;ALB/TH - SD*5.3*530 POST INIT; 05/22/08
- ;;5.3;SCHEDULING;**530,1015**;AUG 13, 1993;Build 21
- ;
- ;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
- SD53P530 ;ALB/TH - SD*5.3*530 POST INIT; 05/22/08
- +1 ;;5.3;SCHEDULING;**530,1015**;AUG 13, 1993;Build 21
- +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
