DG5300PT.m

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 ---DG5300PT   1460     printed  Apr 09, 2024@21:54:44                                                                                                                                                                                                    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