AGEDGUA1.m

AGEDGUA1 ; IHS/ASDS/TPF - EDIT/DISP GUARANTOR SCREEN OVERFLOW ;    

 ;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007

 ;NEW ROUTINE TO HANDLE OVERFLOW FROM AGEDGUAR PER SAC

 Q

GETDATES(WD0) ;EP - GET DTS

 S FLAGS=""

 S FIELDS=";.01I;.02I"

 D LIST^DIC(9000043.0111,WD0,FIELDS,FLAGS,"*",,,,,,"RESULT","ERROR")

 D DATESORT(.RESULT)

 Q

DATESHOW(RESULT) ;EP - SHOW DATE

 N REC

 S REC=0

 F  S REC=$O(RESULT("DILIST","ID",REC)) Q:'REC  D

 . I REC'=1 W !

 . S Y=RESULT("DILIST","ID",REC,.01) X ^DD("DD")

 . S Y=RESULT("DILIST","ID",REC,.02) X ^DD("DD")

 . W ?67,Y

 . W ?79,$S($$ISACTIVE^AGINS(RESULT("DILIST","ID",REC,.01),RESULT("DILIST","ID",REC,.02)):"A",1:"I")

DATESORT(RESULT) ;EP

 N DATESORT,SPECSUB,EFFDT,ENDDT,CVG

 S REC=0

 F  S REC=$O(RESULT("DILIST","ID",REC)) Q:'REC  D

 .S ENDDT=RESULT("DILIST","ID",REC,.02)

 .S EFFDT=RESULT("DILIST","ID",REC,.01)

 .S SPECSUB=$S(ENDDT="":"O",1:"T")  ;O=OPEN ENDED , T=TERM DT

 .I SPECSUB="O" S DATESORT(SPECSUB,EFFDT)=ENDDT

 .E  S DATESORT(SPECSUB,ENDDT)=EFFDT_U

 D SHOWNEW(.DATESORT)

 Q

SHOWNEW(DATESORT) ;EP

 N SPECSUB,DATE,DATE1,EFFDT,ENDDT,REC

 S SPECSUB=""

 S REC=1

 F  S SPECSUB=$O(DATESORT(SPECSUB)) Q:SPECSUB=""  D

 .S DATE=""

 .F  S DATE=$O(DATESORT(SPECSUB,DATE)) Q:DATE=""  D

 ..S DATE1=$P(DATESORT(SPECSUB,DATE),U)

 ..I SPECSUB="O" S EFFDT=DATE,ENDDT=""

 ..E  S EFFDT=DATE1,ENDDT=DATE

 ..I REC'=1 W !

 ..S ITEMNUM=ITEMNUM+1

 ..S ENTRYARY(ITEMNUM)=EFFDT

 ..S $P(AG("C"),",",ITEMNUM)="NEWEFFDT"

 ..W ?0,ITEMNUM_"."

 ..S Y=EFFDT X ^DD("DD")

 ..S DEFEFFDT(ITEMNUM)=EFFDT

 ..W ?4,Y

 ..S Y=ENDDT X ^DD("DD")

 ..W ?40,Y

 ..W ?79,$S($$ISACTIVE^AGINS(EFFDT,ENDDT):"A",1:"I")

 ..S REC=REC+1

 S AG("N")=ITEMNUM

 Q

AGEDGUA1  ; IHS/ASDS/TPF - EDIT/DISP GUARANTOR SCREEN OVERFLOW ;    

 +1       ;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007

 +2       ;NEW ROUTINE TO HANDLE OVERFLOW FROM AGEDGUAR PER SAC

 +3        QUIT 

GETDATES(WD0) ;EP - GET DTS

 +1        SET FLAGS=""

 +2        SET FIELDS=";.01I;.02I"

 +3        DO LIST^DIC(9000043.0111,WD0,FIELDS,FLAGS,"*",,,,,,"RESULT","ERROR")

 +4        DO DATESORT(.RESULT)

 +5        QUIT 

DATESHOW(RESULT) ;EP - SHOW DATE

 +1        NEW REC

 +2        SET REC=0

 +3        FOR 

               SET REC=$ORDER(RESULT("DILIST","ID",REC))

               IF 'REC

                   QUIT 

               Begin DoDot:1

 +4                IF REC'=1

                       WRITE !

 +5                SET Y=RESULT("DILIST","ID",REC,.01)

                   XECUTE ^DD("DD")

 +6                SET Y=RESULT("DILIST","ID",REC,.02)

                   XECUTE ^DD("DD")

 +7                WRITE ?67,Y

 +8                WRITE ?79,$SELECT($$ISACTIVE^AGINS(RESULT("DILIST","ID",REC,.01),RESULT("DILIST","ID",REC,.02)):"A",1:"I")

               End DoDot:1

DATESORT(RESULT) ;EP

 +1        NEW DATESORT,SPECSUB,EFFDT,ENDDT,CVG

 +2        SET REC=0

 +3        FOR 

               SET REC=$ORDER(RESULT("DILIST","ID",REC))

               IF 'REC

                   QUIT 

               Begin DoDot:1

 +4                SET ENDDT=RESULT("DILIST","ID",REC,.02)

 +5                SET EFFDT=RESULT("DILIST","ID",REC,.01)

 +6       ;O=OPEN ENDED , T=TERM DT

                   SET SPECSUB=$SELECT(ENDDT="":"O",1:"T")

 +7                IF SPECSUB="O"

                       SET DATESORT(SPECSUB,EFFDT)=ENDDT

 +8               IF '$TEST

                       SET DATESORT(SPECSUB,ENDDT)=EFFDT_U

               End DoDot:1

 +9        DO SHOWNEW(.DATESORT)

 +10       QUIT 

SHOWNEW(DATESORT) ;EP

 +1        NEW SPECSUB,DATE,DATE1,EFFDT,ENDDT,REC

 +2        SET SPECSUB=""

 +3        SET REC=1

 +4        FOR 

               SET SPECSUB=$ORDER(DATESORT(SPECSUB))

               IF SPECSUB=""

                   QUIT 

               Begin DoDot:1

 +5                SET DATE=""

 +6                FOR 

                       SET DATE=$ORDER(DATESORT(SPECSUB,DATE))

                       IF DATE=""

                           QUIT 

                       Begin DoDot:2

 +7                        SET DATE1=$PIECE(DATESORT(SPECSUB,DATE),U)

 +8                        IF SPECSUB="O"

                               SET EFFDT=DATE

                               SET ENDDT=""

 +9                       IF '$TEST

                               SET EFFDT=DATE1

                               SET ENDDT=DATE

 +10                       IF REC'=1

                               WRITE !

 +11                       SET ITEMNUM=ITEMNUM+1

 +12                       SET ENTRYARY(ITEMNUM)=EFFDT

 +13                       SET $PIECE(AG("C"),",",ITEMNUM)="NEWEFFDT"

 +14                       WRITE ?0,ITEMNUM_"."

 +15                       SET Y=EFFDT

                           XECUTE ^DD("DD")

 +16                       SET DEFEFFDT(ITEMNUM)=EFFDT

 +17                       WRITE ?4,Y

 +18                       SET Y=ENDDT

                           XECUTE ^DD("DD")

 +19                       WRITE ?40,Y

 +20                       WRITE ?79,$SELECT($$ISACTIVE^AGINS(EFFDT,ENDDT):"A",1:"I")

 +21                       SET REC=REC+1

                       End DoDot:2

               End DoDot:1

 +22       SET AG("N")=ITEMNUM

 +23       QUIT