Routine: DGRP15

DGRP15 ;ALB/MTC - TRICARE DEMOGRAPHIC DATA ;03/05/2004

 ;;5.3;Registration;**114,239,568,1015**;Aug 13, 1993;Build 21

EN ;

 N X,Y,DGSA

1 S DGSA=""

 ;-- get sponsor info

 D GET

 ;-- draw header

 S (DGRPS,DGRPW)=15 D H^DGRPU

;--

 S Z=1 D WW^DGRPV W " Sponsor Information:"

 I DGSA D

 . S Y=1,X=0 F  S X=$O(DGSA(X)) Q:'X  D DISPON(X) S Y=Y+1 Q:Y>2

 E   W !,!,"No Sponsor Information available."

W !

2 ;-- Primary Care Manager

 ;-- get primary care data

 .N CT,GBL S GBL="GBL"

 .D TDATA^DGSDUTL(DFN,.CT,DT)

 .I CT>12 S GBL(11,0)="" D

 ..S GBL(12,0)="      *** Additional assignment information exists ***"

 .S CT=0 F  S CT=$O(GBL(CT)) Q:'CT!(CT>12)  W !,GBL(CT,0)

.Q

 ;-- goto main registration screen processing routine

 G ^DGRPP

DISPON(SPON) ;-- This function will display the Sponsor designated by

 ;  SPON.

 W !,!,"    Name : " S Z=$P(DGSA(SPON,"SPON"),U),Z1=30 D WW1^DGRPV

 W ?40,"Military Status : ",$P(DGSA(SPON,"SPON"),U,4)

 W !,"     DOB : " S Z=$P(DGSA(SPON,"SPON"),U,2),Z1=28 D WW1^DGRPV

 W ?35,"Branch of Service : ",$P(DGSA(SPON,"SPON"),U,5)

 W !,"     SSN : " S Z=$P(DGSA(SPON,"SPON"),U,3),Z1=15 D WW1^DGRPV

 W ?52,"Rank : ",$P(DGSA(SPON,"SPON"),U,6)

 W !,"  Prefix : " S Z=$P(DGSA(SPON,"REL"),U,2),Z1=12 D WW1^DGRPV

 W ?52,"Type : ",$P(DGSA(SPON,"REL"),U,3)

 S Y=$P(DGSA(SPON,"REL"),U,4) X ^DD("DD")

 W !,"   Effective Date : ",Y

 S Y=$P(DGSA(SPON,"REL"),U,5) X ^DD("DD")

 W ?35,"Expiration Date: ",Y

GET ;-- get sponsor information and populate the DGSA array.

 ;ihs/cmi/maw 02/08/2012 patch 1014 no IB

 ;D GET^IBCNSU4(DFN,.DGSA)

GETQ Q

EDIT ;-- edit sponsor or primary care ... called from DGRPE

 I DGRPANN["1" D

 . ;D SPON^IBCNSU41(DFN)  ;ihs/cmi/maw 02/08/2012 patch 1014 no IB

 I DGRPANN["2" D

 . W !,"Edit Primary Provider information." H 3 Q

DGRP15    ;ALB/MTC - TRICARE DEMOGRAPHIC DATA ;03/05/2004

 +1       ;;5.3;Registration;**114,239,568,1015**;Aug 13, 1993;Build 21

 +2       ;

EN        ;

 +1        NEW X,Y,DGSA

1          SET DGSA=""

 +1       ;-- get sponsor info

 +2        DO GET

 +3       ;-- draw header

 +4        SET (DGRPS,DGRPW)=15

           DO H^DGRPU

 +5       ;--

 +6        SET Z=1

           DO WW^DGRPV

           WRITE " Sponsor Information:"

 +7        IF DGSA

               Begin DoDot:1

 +8                SET Y=1

                   SET X=0

FOR

                       SET X=$ORDER(DGSA(X))

                       IF 'X

                           QUIT

                       DO DISPON(X)

                       SET Y=Y+1

                       IF Y>2

                           QUIT

               End DoDot:1

 +9       IF '$TEST

               WRITE !,!,"No Sponsor Information available."

 +10      ;

 +11       WRITE !

2         ;-- Primary Care Manager

 +1       ;

 +2       ;-- get primary care data

 +3        Begin DoDot:1

 +4            NEW CT,GBL

               SET GBL="GBL"

 +5            DO TDATA^DGSDUTL(DFN,.CT,DT)

 +6            IF CT>12

                   SET GBL(11,0)=""

                   Begin DoDot:2

 +7                    SET GBL(12,0)="      *** Additional assignment information exists ***"

                   End DoDot:2

 +8            SET CT=0

FOR

                   SET CT=$ORDER(GBL(CT))

                   IF 'CT!(CT>12)

                       QUIT

                   WRITE !,GBL(CT,0)

 +9            QUIT

           End DoDot:1

 +10      ;

 +11      ;-- goto main registration screen processing routine

 +12       GOTO ^DGRPP

 +13      ;

 +14       QUIT

 +15      ;

DISPON(SPON) ;-- This function will display the Sponsor designated by

 +1       ;  SPON.

 +2       ;

 +3        WRITE !,!,"    Name : "

           SET Z=$PIECE(DGSA(SPON,"SPON"),U)

           SET Z1=30

           DO WW1^DGRPV

 +4        WRITE ?40,"Military Status : ",$PIECE(DGSA(SPON,"SPON"),U,4)

 +5        WRITE !,"     DOB : "

           SET Z=$PIECE(DGSA(SPON,"SPON"),U,2)

           SET Z1=28

           DO WW1^DGRPV

 +6        WRITE ?35,"Branch of Service : ",$PIECE(DGSA(SPON,"SPON"),U,5)

 +7        WRITE !,"     SSN : "

           SET Z=$PIECE(DGSA(SPON,"SPON"),U,3)

           SET Z1=15

           DO WW1^DGRPV

 +8        WRITE ?52,"Rank : ",$PIECE(DGSA(SPON,"SPON"),U,6)

 +9        WRITE !,"  Prefix : "

           SET Z=$PIECE(DGSA(SPON,"REL"),U,2)

           SET Z1=12

           DO WW1^DGRPV

 +10       WRITE ?52,"Type : ",$PIECE(DGSA(SPON,"REL"),U,3)

 +11       SET Y=$PIECE(DGSA(SPON,"REL"),U,4)

           XECUTE ^DD("DD")

 +12       WRITE !,"   Effective Date : ",Y

 +13       SET Y=$PIECE(DGSA(SPON,"REL"),U,5)

           XECUTE ^DD("DD")

 +14       WRITE ?35,"Expiration Date: ",Y

 +15       QUIT

 +16      ;

GET       ;-- get sponsor information and populate the DGSA array.

 +1       ;ihs/cmi/maw 02/08/2012 patch 1014 no IB

 +2       ;D GET^IBCNSU4(DFN,.DGSA)

GETQ       QUIT

 +1       ;

EDIT      ;-- edit sponsor or primary care ... called from DGRPE

 +1        IF DGRPANN["1"

               Begin DoDot:1

 +2       ;D SPON^IBCNSU41(DFN)  ;ihs/cmi/maw 02/08/2012 patch 1014 no IB

               End DoDot:1

 +3        IF DGRPANN["2"

               Begin DoDot:1

 +4                WRITE !,"Edit Primary Provider information."

                   HANG 3

                   QUIT

               End DoDot:1

 +5       ;

 +6        QUIT

 +7       ;

DGRP15.m