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
D
.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
;
Q
;
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
Q
;
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
;
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 ;
