source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRP15.m@ 686

Last change on this file since 686 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1DGRP15 ;ALB/MTC - TRICARE DEMOGRAPHIC DATA ;03/05/2004
2 ;;5.3;Registration;**114,239,568**;Aug 13, 1993
3 ;
4EN ;
5 N X,Y,DGSA
61 S DGSA=""
7 ;-- get sponsor info
8 D GET
9 ;-- draw header
10 S (DGRPS,DGRPW)=15 D H^DGRPU
11 ;--
12 S Z=1 D WW^DGRPV W " Sponsor Information:"
13 I DGSA D
14 . S Y=1,X=0 F S X=$O(DGSA(X)) Q:'X D DISPON(X) S Y=Y+1 Q:Y>2
15 E W !,!,"No Sponsor Information available."
16 ;
17 W !
182 ;-- Primary Care Manager
19 ;
20 ;-- get primary care data
21 D
22 .N CT,GBL S GBL="GBL"
23 .D TDATA^DGSDUTL(DFN,.CT,DT)
24 .I CT>12 S GBL(11,0)="" D
25 ..S GBL(12,0)=" *** Additional assignment information exists ***"
26 .S CT=0 F S CT=$O(GBL(CT)) Q:'CT!(CT>12) W !,GBL(CT,0)
27 .Q
28 ;
29 ;-- goto main registration screen processing routine
30 G ^DGRPP
31 ;
32 Q
33 ;
34DISPON(SPON) ;-- This function will display the Sponsor designated by
35 ; SPON.
36 ;
37 W !,!," Name : " S Z=$P(DGSA(SPON,"SPON"),U),Z1=30 D WW1^DGRPV
38 W ?40,"Military Status : ",$P(DGSA(SPON,"SPON"),U,4)
39 W !," DOB : " S Z=$P(DGSA(SPON,"SPON"),U,2),Z1=28 D WW1^DGRPV
40 W ?35,"Branch of Service : ",$P(DGSA(SPON,"SPON"),U,5)
41 W !," SSN : " S Z=$P(DGSA(SPON,"SPON"),U,3),Z1=15 D WW1^DGRPV
42 W ?52,"Rank : ",$P(DGSA(SPON,"SPON"),U,6)
43 W !," Prefix : " S Z=$P(DGSA(SPON,"REL"),U,2),Z1=12 D WW1^DGRPV
44 W ?52,"Type : ",$P(DGSA(SPON,"REL"),U,3)
45 S Y=$P(DGSA(SPON,"REL"),U,4) X ^DD("DD")
46 W !," Effective Date : ",Y
47 S Y=$P(DGSA(SPON,"REL"),U,5) X ^DD("DD")
48 W ?35,"Expiration Date: ",Y
49 Q
50 ;
51GET ;-- get sponsor information and populate the DGSA array.
52 D GET^IBCNSU4(DFN,.DGSA)
53GETQ Q
54 ;
55EDIT ;-- edit sponsor or primary care ... called from DGRPE
56 I DGRPANN["1" D
57 . D SPON^IBCNSU41(DFN)
58 I DGRPANN["2" D
59 . W !,"Edit Primary Provider information." H 3 Q
60 ;
61 Q
62 ;
Note: See TracBrowser for help on using the repository browser.