DG5300PT ;ALB/SEK NO LONGER APPLICABLE STATUS CLEANUP POST-INS ; 07/31/96
;;5.3;Registration;**100**;Aug 13, 1993
;
;This routine will be run as a post-installation for patch DG*5.3*100.
;This routine will change the STATUS field (#.03) to 10 in the
;ANNUAL MEANS TEST file (408.13) for any copay test that has a NO
;LONGER REQUIRED DATE (#.17) and the STATUS field of 7. This
;problem only occurred when the patient went from non-exempt SC less
;than 50% to SC 50% to 100%.
;
POST ;entry point for post-install, setting up checkpoints
N %
S %=$$NEWCP^XPDUTL("DGTTDT","EN^DG5300PT",0)
Q
;
EN ; begin processing
;
;go through ANNUAL MEANS TEST file changing STATUS to 10 for copay
;tests that have a NO LONGER REQUIRED DATE and STATUS of 7.
N DGTTDT
;
D BMES^XPDUTL(" >> Copay no longer applicable status Clean-up")
;
;get value from checkpoints, previous run
S DGTTDT=+$$PARCP^XPDUTL("DGTTDT")
;
LOOP ;
N DFN,DGFL,DGFLD,DGIEN,DGMTA,DGVAL,%
F S DGTTDT=$O(^DGMT(408.31,"AS",2,7,DGTTDT)) Q:'DGTTDT D
.S DFN=0 F S DFN=$O(^DGMT(408.31,"AS",2,7,DGTTDT,DFN)) Q:'DFN D
..S DGIEN=0 F S DGIEN=$O(^DGMT(408.31,"AS",2,7,DGTTDT,DFN,DGIEN)) Q:'DGIEN D
...S DGMTA=$G(^DGMT(408.31,DGIEN,0)) Q:'DGMTA
...Q:$P(DGMTA,"^",17)=""
...S DGFL=408.31,DGFLD=.03,DGVAL=7 D KILL^DGMTR
...S DGVAL=10,$P(^DGMT(408.31,DGIEN,0),"^",3)=DGVAL D SET^DGMTR
.;update checkpoint
.S %=$$UPCP^XPDUTL("DGTTDT",DGTTDT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG5300PT 1460 printed Dec 13, 2024@02:35:33 Page 2
DG5300PT ;ALB/SEK NO LONGER APPLICABLE STATUS CLEANUP POST-INS ; 07/31/96
+1 ;;5.3;Registration;**100**;Aug 13, 1993
+2 ;
+3 ;This routine will be run as a post-installation for patch DG*5.3*100.
+4 ;This routine will change the STATUS field (#.03) to 10 in the
+5 ;ANNUAL MEANS TEST file (408.13) for any copay test that has a NO
+6 ;LONGER REQUIRED DATE (#.17) and the STATUS field of 7. This
+7 ;problem only occurred when the patient went from non-exempt SC less
+8 ;than 50% to SC 50% to 100%.
+9 ;
POST ;entry point for post-install, setting up checkpoints
+1 NEW %
+2 SET %=$$NEWCP^XPDUTL("DGTTDT","EN^DG5300PT",0)
+3 QUIT
+4 ;
EN ; begin processing
+1 ;
+2 ;go through ANNUAL MEANS TEST file changing STATUS to 10 for copay
+3 ;tests that have a NO LONGER REQUIRED DATE and STATUS of 7.
+4 NEW DGTTDT
+5 ;
+6 DO BMES^XPDUTL(" >> Copay no longer applicable status Clean-up")
+7 ;
+8 ;get value from checkpoints, previous run
+9 SET DGTTDT=+$$PARCP^XPDUTL("DGTTDT")
+10 ;
LOOP ;
+1 NEW DFN,DGFL,DGFLD,DGIEN,DGMTA,DGVAL,%
+2 FOR
SET DGTTDT=$ORDER(^DGMT(408.31,"AS",2,7,DGTTDT))
if 'DGTTDT
QUIT
Begin DoDot:1
+3 SET DFN=0
FOR
SET DFN=$ORDER(^DGMT(408.31,"AS",2,7,DGTTDT,DFN))
if 'DFN
QUIT
Begin DoDot:2
+4 SET DGIEN=0
FOR
SET DGIEN=$ORDER(^DGMT(408.31,"AS",2,7,DGTTDT,DFN,DGIEN))
if 'DGIEN
QUIT
Begin DoDot:3
+5 SET DGMTA=$GET(^DGMT(408.31,DGIEN,0))
if 'DGMTA
QUIT
+6 if $PIECE(DGMTA,"^",17)=""
QUIT
+7 SET DGFL=408.31
SET DGFLD=.03
SET DGVAL=7
DO KILL^DGMTR
+8 SET DGVAL=10
SET $PIECE(^DGMT(408.31,DGIEN,0),"^",3)=DGVAL
DO SET^DGMTR
End DoDot:3
End DoDot:2
+9 ;update checkpoint
+10 SET %=$$UPCP^XPDUTL("DGTTDT",DGTTDT)
End DoDot:1
+11 QUIT
