DG1010P3 ;ALB/REW - PRINT 1010 CONT'D PART III ; 8/18/00 9:47am
;;5.3;Registration;**343**;Aug 13, 1993
;;1
PARTIII ;
K DGP,DGD,DESTXT,DGADDR,DGD1,DGDCTY,DGDSL,DGDST,DGDSTR,DGDSUM,DGDZIP,DGQ,DG1010P2
F I="VET",0,.13,.22,.25,.3,.311,.32,.321,.322,.36,.52,.53 S DGP(I)=$G(^DPT(DFN,I))
S DGDMAX=1
S X=$$POINT^DG1010P0(DGP(0),5,11,3),DGNOTMAR=$S(((X="M")!(X="S")):0,1:1) ;0=>MARRIED,SEPARATED
S DGSPC=1,DGBLANK=0
W !!,?50,"PART III - APPLICANT/SPOUSE DATA",!,$C(13),DGLUND
S DGNA=DGNOTMAR
;$$DISP(N,P,NA,BL) RETURNS THE Pth PIECE OF NODE N USUALLY N=DGP(Z) WHERE Z IS NODE SUBSCRIPT NULL=UNANWERED OR NOT APPLICABLE BASED ON NA. BL=1 WILL CAUSE ""(NOTHING) PRINTED
W !,"1. APPLICANT'S EMPLOYMENT STATUS: ",$$ESTATUS(DGP(.311)),!,$C(13),DGLUND
;X IS EMP STATUS NUMBER ON FORM
S DGVUNEMP=$S(("3^7"[+X):1,1:0)
W !,"2. SPOUSE'S EMPLOYMENT STATUS: ",$$ESTATUS(DGP(.25),DGNA),!,$C(13),DGLUND
S DGSUNEMP=$S(("3^7"[+X):1,1:0)
W !,?66,"| ",!?14,"3. APPLICANT INFORMATION",?66,"| ",?87,"4. SPOUSE'S INFORMATION",?131,$C(13),DGLUND
W !,"3A. OCCUPATION: ",$$DISP^DG1010P0(DGP(0),7),?66,"| ","4A. OCCUPATION: ",$$DISP^DG1010P0(DGP(.25),14,DGNA),!,DGL2
W !,"3B. EMPLOYER (Name, Street Address, City, State, Zip)",?66,"| "
W "4B. EMPLOYER (Name, Street Address, City, State, Zip)"
NAME W !?5,$$DISP^DG1010P0(DGP(.311),1,DGVUNEMP) S (DGBLANK,DGBLANK1)=DGUNK
S DGNA=$S(DGSUNEMP:1,1:DGNA)
W ?66,"| ",?73,$$DISP^DG1010P0(DGP(.25),1,DGNA) S DGBLANK2=DGUNK
SETADD ;
S DGI=.311,DGNA=0
I (DGNOTMAR)!(DGSUNEMP) F DGDPC=3:1:8 S DGD(.25,DGDPC)=""
I DGVUNEMP F DGDPC=3:1:8 S DGD(.311,DGDPC)=""
S DGPCDIFF=0 ;OFFSET FROM APPLICANT PIECE
F DGI=.311,.25 D
.Q:(DGI=.25)&(DGNOTMAR!DGSUNEMP)
.Q:(DGI=.311)&(DGVUNEMP)
.I DGI=.25 S DGPCDIFF=-1,DGNA=DGNOTMAR,DGBLANK=DGBLANK2
.;ADDR=3-5,6-8=CITY,STATE (NOTE:ZIP+4 IS ON .22 NODE & NOT 8TH PC)
.F DGDPC=3:1:8 D
..S:(DGDPC<6) DGD(DGI,DGDPC)=$$DISP^DG1010P0(DGP(DGI),(DGDPC+DGPCDIFF),0,1)
..S:(DGDPC=6) DGD(DGI,DGDPC)=$$DISP^DG1010P0(DGP(DGI),(DGDPC+DGPCDIFF),0,1)_$S(('DGUNK):", ",1:"")
..S:(DGDPC=7) X=$P(DGP(DGI),U,7+DGPCDIFF),DGD(DGI,DGDPC)=$$UNK^DG1010P0($P($G(^DIC(5,+X,0)),U,2),0,1)_$S(('DGUNK):", ",1:"")
..I (DGDPC=4)!(DGDPC=5) S:(DGDMAX<DGDPC)&($L(DGD(DGI,DGDPC))) DGDMAX=DGDPC
..S:(DGDPC=8) DGD(DGI,DGDPC)=$$DISP^DG1010P0(DGP(.22),($S(DGI=.25:6,1:5)),0,1)
S DGBLANK=0
STREET W !?5,DGD(.311,3),?66,"| ",?73,DGD(.25,3)
W:(DGDMAX>3) !?5,DGD(.311,4),?66,"|",?73,DGD(.25,4)
W:(DGDMAX>4) !?5,DGD(.311,5),?66,"|",?73,DGD(.25,5)
CTSTZP W !?5,DGD(.311,6),DGD(.311,7),DGD(.311,8),?66,"| ",?73,DGD(.25,6),DGD(.25,7),DGD(.25,8),!,DGL2
W !,"3C. WORK TELEPHONE NUMBER: ",$$DISP^DG1010P0(DGP(.311),9,0,DGBLANK1),?66,"| ","4C. WORK TELEPHONE NUMBER: ",$$DISP^DG1010P0(DGP(.25),8,DGNA,DGBLANK2),?131,$C(13),DGLUND
K DGVUNEMP,DGSUNEMP
G PARTIV^DG1010P4
ESTATUS(N,NA) ;
; Returns the external value of the Employment Status for either the
; Spouse or the Patient, unless NA=1.
; INPUT: N -- A node [either the .311 or the .25]
; NA -- If =1 returns 'NOT APPLICABLE'
; [N is REQUIRED]
; OUTPUT[Returned & SET] -- X
I $G(NA) S X="NOT APPLICABLE" G QE
S X=+($P(N,U,15))
I 'X S X="NOT ANSWERED" G QE
S X=$P($P(^DD(2,.31115,0),U,3),";",X)
I 'X S X="7. UNKNOWN" G QE ;RESULT IF INPUT X>6
S X=+X_". "_$P(X,":",2)
QE ;
Q X
DG1010P3 ;ALB/REW - PRINT 1010 CONT'D PART III ; 8/18/00 9:47am
+1 ;;5.3;Registration;**343**;Aug 13, 1993
+2 ;;1
PARTIII ;
+1 KILL DGP,DGD,DESTXT,DGADDR,DGD1,DGDCTY,DGDSL,DGDST,DGDSTR,DGDSUM,DGDZIP,DGQ,DG1010P2
+2 FOR I="VET",0,.13,.22,.25,.3,.311,.32,.321,.322,.36,.52,.53
SET DGP(I)=$GET(^DPT(DFN,I))
+3 SET DGDMAX=1
+4 ;0=>MARRIED,SEPARATED
SET X=$$POINT^DG1010P0(DGP(0),5,11,3)
SET DGNOTMAR=$SELECT(((X="M")!(X="S")):0,1:1)
+5 SET DGSPC=1
SET DGBLANK=0
+6 WRITE !!,?50,"PART III - APPLICANT/SPOUSE DATA",!,$CHAR(13),DGLUND
+7 SET DGNA=DGNOTMAR
+8 ;$$DISP(N,P,NA,BL) RETURNS THE Pth PIECE OF NODE N USUALLY N=DGP(Z) WHERE Z IS NODE SUBSCRIPT NULL=UNANWERED OR NOT APPLICABLE BASED ON NA. BL=1 WILL CAUSE ""(NOTHING) PRINTED
+9 WRITE !,"1. APPLICANT'S EMPLOYMENT STATUS: ",$$ESTATUS(DGP(.311)),!,$CHAR(13),DGLUND
+10 ;X IS EMP STATUS NUMBER ON FORM
+11 SET DGVUNEMP=$SELECT(("3^7"[+X):1,1:0)
+12 WRITE !,"2. SPOUSE'S EMPLOYMENT STATUS: ",$$ESTATUS(DGP(.25),DGNA),!,$CHAR(13),DGLUND
+13 SET DGSUNEMP=$SELECT(("3^7"[+X):1,1:0)
+14 WRITE !,?66,"| ",!?14,"3. APPLICANT INFORMATION",?66,"| ",?87,"4. SPOUSE'S INFORMATION",?131,$CHAR(13),DGLUND
+15 WRITE !,"3A. OCCUPATION: ",$$DISP^DG1010P0(DGP(0),7),?66,"| ","4A. OCCUPATION: ",$$DISP^DG1010P0(DGP(.25),14,DGNA),!,DGL2
+16 WRITE !,"3B. EMPLOYER (Name, Street Address, City, State, Zip)",?66,"| "
+17 WRITE "4B. EMPLOYER (Name, Street Address, City, State, Zip)"
NAME WRITE !?5,$$DISP^DG1010P0(DGP(.311),1,DGVUNEMP)
SET (DGBLANK,DGBLANK1)=DGUNK
+1 SET DGNA=$SELECT(DGSUNEMP:1,1:DGNA)
+2 WRITE ?66,"| ",?73,$$DISP^DG1010P0(DGP(.25),1,DGNA)
SET DGBLANK2=DGUNK
SETADD ;
+1 SET DGI=.311
SET DGNA=0
+2 IF (DGNOTMAR)!(DGSUNEMP)
FOR DGDPC=3:1:8
SET DGD(.25,DGDPC)=""
+3 IF DGVUNEMP
FOR DGDPC=3:1:8
SET DGD(.311,DGDPC)=""
+4 ;OFFSET FROM APPLICANT PIECE
SET DGPCDIFF=0
+5 FOR DGI=.311,.25
Begin DoDot:1
+6 IF (DGI=.25)&(DGNOTMAR!DGSUNEMP)
QUIT
+7 IF (DGI=.311)&(DGVUNEMP)
QUIT
+8 IF DGI=.25
SET DGPCDIFF=-1
SET DGNA=DGNOTMAR
SET DGBLANK=DGBLANK2
+9 ;ADDR=3-5,6-8=CITY,STATE (NOTE:ZIP+4 IS ON .22 NODE & NOT 8TH PC)
+10 FOR DGDPC=3:1:8
Begin DoDot:2
+11 IF (DGDPC<6)
SET DGD(DGI,DGDPC)=$$DISP^DG1010P0(DGP(DGI),(DGDPC+DGPCDIFF),0,1)
+12 IF (DGDPC=6)
SET DGD(DGI,DGDPC)=$$DISP^DG1010P0(DGP(DGI),(DGDPC+DGPCDIFF),0,1)_$SELECT(('DGUNK):", ",1:"")
+13 IF (DGDPC=7)
SET X=$PIECE(DGP(DGI),U,7+DGPCDIFF)
SET DGD(DGI,DGDPC)=$$UNK^DG1010P0($PIECE($GET(^DIC(5,+X,0)),U,2),0,1)_$SELECT(('DGUNK):", ",1:"")
+14 IF (DGDPC=4)!(DGDPC=5)
IF (DGDMAX<DGDPC)&($LENGTH(DGD(DGI,DGDPC)))
SET DGDMAX=DGDPC
+15 IF (DGDPC=8)
SET DGD(DGI,DGDPC)=$$DISP^DG1010P0(DGP(.22),($SELECT(DGI=.25:6,1:5)),0,1)
End DoDot:2
End DoDot:1
+16 SET DGBLANK=0
STREET WRITE !?5,DGD(.311,3),?66,"| ",?73,DGD(.25,3)
+1 IF (DGDMAX>3)
WRITE !?5,DGD(.311,4),?66,"|",?73,DGD(.25,4)
+2 IF (DGDMAX>4)
WRITE !?5,DGD(.311,5),?66,"|",?73,DGD(.25,5)
CTSTZP WRITE !?5,DGD(.311,6),DGD(.311,7),DGD(.311,8),?66,"| ",?73,DGD(.25,6),DGD(.25,7),DGD(.25,8),!,DGL2
+1 WRITE !,"3C. WORK TELEPHONE NUMBER: ",$$DISP^DG1010P0(DGP(.311),9,0,DGBLANK1),?66,"| ","4C. WORK TELEPHONE NUMBER: ",$$DISP^DG1010P0(DGP(.25),8,DGNA,DGBLANK2),?131,$CHAR(13),DGLUND
+2 KILL DGVUNEMP,DGSUNEMP
+3 GOTO PARTIV^DG1010P4
ESTATUS(N,NA) ;
+1 ; Returns the external value of the Employment Status for either the
+2 ; Spouse or the Patient, unless NA=1.
+3 ; INPUT: N -- A node [either the .311 or the .25]
+4 ; NA -- If =1 returns 'NOT APPLICABLE'
+5 ; [N is REQUIRED]
+6 ; OUTPUT[Returned & SET] -- X
+7 IF $GET(NA)
SET X="NOT APPLICABLE"
GOTO QE
+8 SET X=+($PIECE(N,U,15))
+9 IF 'X
SET X="NOT ANSWERED"
GOTO QE
+10 SET X=$PIECE($PIECE(^DD(2,.31115,0),U,3),";",X)
+11 ;RESULT IF INPUT X>6
IF 'X
SET X="7. UNKNOWN"
GOTO QE
+12 SET X=+X_". "_$PIECE(X,":",2)
QE ;
+1 QUIT X
