Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG1010P1

DG1010P1.m

Go to the documentation of this file. 
  1. DG1010P1 ;ALB/REW - VA FORM 10-10 (CONT) ; 26 MAY 92
  1.  ;;5.3;Registration;**489**;Aug 13, 1993
  1.  ; DGP(N)   = NTH NODE OF PATIENT FILE - ALREADY DEFINED
  1. ST W !?25,"SEE ATTACHMENT FOR PAPERWORK REDUCTION INFORMATION AND PRIVACY ACT INFORMATION",!,DGLDASH
  1.  I $G(IOST)["C-" S DGLUND=""
  1. PARTI W !?54,"PART I - PATIENT DATA",!,DGLUND
  1.  S DGD=+$P(DGP("DIS",0),U,3) W !,"1.  Type of benefit applied for:  ",$P("HOSPITAL/OUTPATIENT TREATMENT^DOMICILIARY CARE^HOSPITAL/OUTPATIENT TREATMENT^OUTPATIENT DENTAL^NURSING HOME CARE",U,+DGD)
  1.  W !,DGLUND
  1.  W !,"2.   Applicant's Name  ",?48,"|"," 3.  Other names used (Alias)",?86,"|"," 4.  Social Security Number"
  1.  S DGX=$O(^DPT(DFN,.01,0)) S DGA=$P($G(^DPT(DFN,.01,+DGX,0)),U,1)
  1.  W !?5,DGNAM,?48,"|",?54,DGA,?86,"|",?92,DGSS
  1.  F  S DGX=$O(^DPT(DFN,.01,DGX)) Q:DGX'>0  W !?48,"|",?54,$P($G(^DPT(DFN,.01,DGX,0)),U,1),?86,"|"
  1.  W ?131,"",$C(13),DGLUND
  1. CLAIM ;
  1.  W !,"5.   Claim Number",?23,"| 6.  LOCATION OF CLAIMS FOLDER",?60,"| 7.  DATE OF BIRTH",?86,"| 8.  PLACE OF BIRTH"
  1.  S DGX=$$DISP^DG1010P0(DGP(.31),3)
  1.  W !?5,$S('DGUNK:"C- ",1:""),DGX,?23,"|     ",$E($$DISP^DG1010P0(DGP(.31),2),1,30),?60,"|     ",$$DATENP^DG1010P0(DGP(0),3)
  1.  S DGD=$$DISP^DG1010P0(DGP(0),11,0,1),DGNOCITY=DGUNK,DGD1=$$POINT^DG1010P0(DGP(0),12,5,1,0,1)
  1.  W ?86,"|     ",$E($S((DGNOCITY&DGUNK):"UNANSWERED",1:DGD_$S(($L(DGD)):", ",1:"")_DGD1),1,39),?131,$C(13),DGLUND
  1. HEADADD ;
  1.  S DGD1=$$DATENP^DG1010P0(DGP(.121),7,0,1) ;FROM
  1.  S DGD2=$$DATENP^DG1010P0(DGP(.121),8,0,1) ;TO
  1.  W !,"9.   PERMANENT ADDRESS",?66,"|"," 10.  TEMPORARY ADDRESS "
  1.  S DGDMAX=1
  1. PRTTMP ; DGTMP=0 IF TEMP ADDRES ENTER NOT=Y OR END DATE IN PAST
  1.  K DGD
  1.  S DGTMP=1
  1.  I ($P(DGP(.121),U,9)'="Y")!(($P(DGP(.121),U,8)>0)&($P(DGP(.121),U,8)<(9999999-DFN1))) S DGTMP=0 S DGD(.121,1)="NOT APPLICABLE" F DGDPC=2:1:5,12 S DGD(.121,DGDPC)=""
  1.  W:(DGTMP=1)&($L(DGD1)!($L(DGD2))) "(FROM  ",DGD1,"  TO ",DGD2,?126,")"
  1.  W !,DGL2
  1. GETADD ;
  1. STR2ZIP F DGI=.11,.121 Q:((DGI=.121)&(DGTMP=0))  D
  1.  .;ADDR=1-3,4-5=CITY,STATE,12=ZIP+4
  1.  .F DGDPC=1:1:5,12 D
  1.  ..I ("^1^4^12^"[DGDPC) S DGD(DGI,DGDPC)=$$DISP^DG1010P0(DGP(DGI),DGDPC) I DGDPC=12,(DGD(DGI,12)?9N) S DGD(DGI,12)=$E(DGD(DGI,12),1,5)_"-"_$E(DGD(DGI,12),6,9)
  1.  ..I ("23"[DGDPC) S DGD(DGI,DGDPC)=$$DISP^DG1010P0(DGP(DGI),DGDPC,0,1) S:(DGDMAX<DGDPC)&($L(DGD(DGI,DGDPC))) DGDMAX=DGDPC
  1.  ..I (DGDPC=5) S X=$$POINT^DG1010P0(DGP(DGI),5,5,1),DGD(DGI,5)=$S(($L(X)<19):X,$L($$POINT^DG1010P0(DGP(DGI),5,5,2,0,1)):$$POINT^DG1010P0(DGP(DGI),5,5,2),1:$E(X,1,18))
  1.  S:(DGTMP=0) DGD(.121,11)=""
  1. WRADD W !,"9A.  STREET ADDRESS:",?21,DGD(.11,1),?66,"|"," 10A. STREET ADDRESS:",?89,DGD(.121,1)
  1.  W:(DGDMAX>1) !?21,DGD(.11,2),?66,"|",?89,DGD(.121,2)
  1.  W:(DGDMAX>2) !?21,DGD(.11,3),?66,"|",?89,DGD(.121,3)
  1.  W !,DGL2
  1.  W !,"9B.  CITY: ",DGD(.11,4),?33,"| ","9C.  STATE: ",DGD(.11,5),?66,"|"," 10B. CITY: ",$E(DGD(.121,4),1,20),?99,"| ","10C. STATE: ",DGD(.121,5),!,DGL2
  1.  W !,"9D.  ZIP CODE: ",DGD(.11,12),?33,"| ","9E.  COUNTY: ",$$POINT^DG1010P0(DGP(.11),7,("^DIC(5,"_+$P(DGP(.11),U,5)_",1,"),0),?66,"| "
  1.  W "10D. ZIP CODE: ",DGD(.121,12),?99,"| ","10E. COUNTY: "
  1.  W:(DGTMP=1) $$POINT^DG1010P0(DGP(.121),11,("^DIC(5,"_+$P(DGP(.121),U,5)_",1,"),0)
  1.  W !,DGL2
  1.  W !,"9F.  HOME TELEPHONE NUMBER: ",$$DISP^DG1010P0(DGP(.13),1),?66,"| ","10F. HOME TELEPHONE NUMBER:",?96
  1.  W:DGTMP $$DISP^DG1010P0(DGP(.121),10)
  1.  W !,DGLUND
  1. CA ;Display confidential address information
  1.  N DGACT,DGCAT,DGCATN,DGCATS,VAPA
  1.  D ADD^VADPT
  1.  W !,"11. CONFIDENTIAL ADDRESS",?66,"|"
  1.  I VAPA(12)=""!(VAPA(12)=0) D  G SEX
  1.  .W !?11,"Not Applicable",?66,"|"
  1.  .W !,DGLUND
  1.  W !,DGL2
  1.  W !,"11A.  STREET ADDRESS:",?21,VAPA(13)
  1.  W ?66,"| ","11B.  CITY:  ",$E(VAPA(16),0,19),?99,"| 11C. STATE: ",$P(VAPA(17),"^",2)
  1.  W !,?21,VAPA(14)
  1.  W ?66,"| ","11D.  ZIP CODE:  ",$P(VAPA(18),"^",2),?99,"| 11E. COUNTY: ",$P(VAPA(19),"^",2)
  1.  W !,?21,VAPA(15),?66,"| 11F. START DATE: ",$P(VAPA(20),"^",2),?99,"| STOP DATE: ",$P(VAPA(21),"^",2)
  1.  W !,$E(DGL2,1,99),"|",$E(DGL2,1,32)
  1.  W !,"11G. Active Confidential Address Categories",?66,"|"
  1.  S DGCATS="" F  S DGCATS=$O(VAPA(22,DGCATS)) Q:DGCATS=""  D
  1.  .S DGCAT=VAPA(22,DGCATS),DGACT=$P(DGCAT,"^",3),DGCATN=$P(DGCAT,"^",2)
  1.  .I DGACT="Y" W !?11,DGCATN,?66,"|"
  1.  W !,DGLUND
  1. SEX K DGD,DGX
  1.  W !,"12.  PATIENT'S SEX",?33,"| ","13.  MOTHER'S MAIDEN NAME",?66,"| ","14.  MOTHER'S NAME",?99,"| ","15.  FATHER'S NAME"
  1.  S X=$P(DGP(0),U,2) W !?5,$S((X="M"):"MALE",(X="F"):"FEMALE",1:"UNANSWERED")
  1.  W ?33,"| ",?40,$E(($$DISP^DG1010P0(DGP(.24),3)),1,25),?66,"| ",?73,$E(($$DISP^DG1010P0(DGP(.24),2)),1,23),?99,"| ",?106,$E(($$DISP^DG1010P0(DGP(.24),1)),1,30),?131,$C(13),DGLUND
  1. RELIG ;
  1.  W !,"16.  RELIGIOUS PREFERENCE",?33,"| ","17.  DATE OF PREVIOUS CARE",?66,"| ","18.  LOCATION OF PREVIOUS CARE",?99,"| ","19.  SPINAL CORD INJURY"
  1.  W !?5,$$POINT^DG1010P0(DGP(0),8,13),?33,"| ",?40,$$DATENP^DG1010P0(DGP(1010.15),1),?66,"| ",?73,$$POINT^DG1010P0(DGP(1010.15),2,4)
  1.  S X=$$UNK^DG1010P0($P(DGP(57),U,4))
  1.  W ?99,"| ",?106,$S((DGUNK):X,(X=1):"PARAPLEGIA-TRAUMATIC",(X=2):"QUADRIPLEGIA-TRAUMATIC",(X=3):"PARAPLEGIA-NONTRAUMATIC",(X=4):"QUADRIPLEGIA-NONTRAUMATIC",(X="X"):"NOT APPLICABLE",1:"INVALID"),?131,$C(13),DGLUND,!
  1. CONTD ;
  1.  G CONT^DG1010P2
  1.  ;