Released DG*5.3*487 SEQ #457 Extracted from mail message **KIDS**:DG*5.3*487^ **INSTALL NAME** DG*5.3*487 "BLD",3783,0) DG*5.3*487^REGISTRATION^0^3030304^y "BLD",3783,1,0) ^^1^1^3021211^^ "BLD",3783,1,1,0) See patch description for DG*5.3*487. "BLD",3783,4,0) ^9.64PA^^ "BLD",3783,"ABPKG") n "BLD",3783,"KRN",0) ^9.67PA^8989.52^19 "BLD",3783,"KRN",.4,0) .4 "BLD",3783,"KRN",.401,0) .401 "BLD",3783,"KRN",.402,0) .402 "BLD",3783,"KRN",.403,0) .403 "BLD",3783,"KRN",.5,0) .5 "BLD",3783,"KRN",.84,0) .84 "BLD",3783,"KRN",3.6,0) 3.6 "BLD",3783,"KRN",3.8,0) 3.8 "BLD",3783,"KRN",9.2,0) 9.2 "BLD",3783,"KRN",9.8,0) 9.8 "BLD",3783,"KRN",9.8,"NM",0) ^9.68A^3^2 "BLD",3783,"KRN",9.8,"NM",2,0) DGRP9^^0^B24427361 "BLD",3783,"KRN",9.8,"NM",3,0) DGRP8^^0^B465963 "BLD",3783,"KRN",9.8,"NM","B","DGRP8",3) "BLD",3783,"KRN",9.8,"NM","B","DGRP9",2) "BLD",3783,"KRN",19,0) 19 "BLD",3783,"KRN",19,"NM",0) ^9.68A^^ "BLD",3783,"KRN",19.1,0) 19.1 "BLD",3783,"KRN",101,0) 101 "BLD",3783,"KRN",409.61,0) 409.61 "BLD",3783,"KRN",771,0) 771 "BLD",3783,"KRN",870,0) 870 "BLD",3783,"KRN",8989.51,0) 8989.51 "BLD",3783,"KRN",8989.52,0) 8989.52 "BLD",3783,"KRN",8994,0) 8994 "BLD",3783,"KRN","B",.4,.4) "BLD",3783,"KRN","B",.401,.401) "BLD",3783,"KRN","B",.402,.402) "BLD",3783,"KRN","B",.403,.403) "BLD",3783,"KRN","B",.5,.5) "BLD",3783,"KRN","B",.84,.84) "BLD",3783,"KRN","B",3.6,3.6) "BLD",3783,"KRN","B",3.8,3.8) "BLD",3783,"KRN","B",9.2,9.2) "BLD",3783,"KRN","B",9.8,9.8) "BLD",3783,"KRN","B",19,19) "BLD",3783,"KRN","B",19.1,19.1) "BLD",3783,"KRN","B",101,101) "BLD",3783,"KRN","B",409.61,409.61) "BLD",3783,"KRN","B",771,771) "BLD",3783,"KRN","B",870,870) "BLD",3783,"KRN","B",8989.51,8989.51) "BLD",3783,"KRN","B",8989.52,8989.52) "BLD",3783,"KRN","B",8994,8994) "BLD",3783,"QUES",0) ^9.62^^ "BLD",3783,"REQB",0) ^9.611^^ "MBREQ") 0 "PKG",5,-1) 1^1 "PKG",5,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",5,20,0) ^9.402P^^ "PKG",5,22,0) ^9.49I^1^1 "PKG",5,22,1,0) 5.3^2941102^2941102 "PKG",5,22,1,"PAH",1,0) 487^3030304 "PKG",5,22,1,"PAH",1,1,0) ^^1^1^3030304 "PKG",5,22,1,"PAH",1,1,1,0) See patch description for DG*5.3*487. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") YES "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") YES "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 2 "RTN","DGRP8") 0^3^B465963 "RTN","DGRP8",1,0) DGRP8 ;ALB/MIR - FAMILY DEMOGRAPHIC SCREEN DISPLAY ; 12 FEB 92 "RTN","DGRP8",2,0) ;;5.3;Registration;**45,54,487**;Aug 13, 1993 "RTN","DGRP8",3,0) ; "RTN","DGRP8",4,0) ; Screen to display current spouse and dependents "RTN","DGRP8",5,0) ; "RTN","DGRP8",6,0) EN I $D(DVBGUI) G ENQ ; IF CALLED BY CAPRI, SKIP SCREEN 8 "RTN","DGRP8",7,0) ; "RTN","DGRP8",8,0) ; Start display "RTN","DGRP8",9,0) N DGMTYPT,DGMTCP,DGXR,DGSCR8 "RTN","DGRP8",10,0) S DGSCR8=1 D EN^DGDEP "RTN","DGRP8",11,0) ; "RTN","DGRP8",12,0) ENQ S X=132 X ^%ZOSF("RM") "RTN","DGRP8",13,0) N I,X F I=9:1 S X=$E(DGRPVV,I) Q:'X "RTN","DGRP8",14,0) S DGRPANN="^"_I "RTN","DGRP8",15,0) G JUMP^DGRPP ; jumps to next 'on' screen "RTN","DGRP9") 0^2^B24427361 "RTN","DGRP9",1,0) DGRP9 ;ALB/RMO/MIR - Screen 9 - Income Screening Data ;23 JAN 1992 11:00 am "RTN","DGRP9",2,0) ;;5.3;Registration;**45,108,487**;Aug 13, 1993 "RTN","DGRP9",3,0) ; "RTN","DGRP9",4,0) EN ; "RTN","DGRP9",5,0) ; DVBGUI : CAPRI GUI User "RTN","DGRP9",6,0) I $D(DVBGUI) U IO ;If called from CAPRI menu set output device. "RTN","DGRP9",7,0) K DGDEP,DGINC,DGREL N DGMT,DGEFDT,DGEFDT,DGMTED,DGNOBUCK,DGLSTYR "RTN","DGRP9",8,0) S DGLSTYR=$E(DT,1,3)+1699 "RTN","DGRP9",9,0) S DGRPS=9 D H^DGRPU "RTN","DGRP9",10,0) D:'DGRPV NEW^DGRPEIS1 "RTN","DGRP9",11,0) D ALL^DGMTU21(DFN,"VSD",DT,"IPR") "RTN","DGRP9",12,0) S DGNOBUCK=$S(DGRPV:0,1:$$NOBUCKS^DGMTU22(DFN,DT)) "RTN","DGRP9",13,0) S DGMT=$$LST^DGMTU(DFN,DT),DGEFDT=$P(DGMT,U,2) "RTN","DGRP9",14,0) S:'((DGEFDT+10000)>DT&("^A^C^P^E^M^"[(U_$P(DGMT,U,4)))&DGNOBUCK) DGEFDT=DT "RTN","DGRP9",15,0) S DGISYR=$E($$LYR^DGMTSCU1(DGEFDT),1,3)+1700 ; IS year "RTN","DGRP9",16,0) D:DT'=DGEFDT ALL^DGMTU21(DFN,"VSD",DGEFDT,"IPR") "RTN","DGRP9",17,0) S DGSP=$D(DGREL("S")) ; DGSP = flag ... + if spouse, 0 if not "RTN","DGRP9",18,0) D TOT(.DGINC) "RTN","DGRP9",19,0) D DIS "RTN","DGRP9",20,0) W:DGNOBUCK !," NOTE: Since there is no income data for "_DGLSTYR_" you may COPY "_(DGLSTYR-1)_" data." "RTN","DGRP9",21,0) K DGTOT "RTN","DGRP9",22,0) G ^DGRPP "RTN","DGRP9",23,0) ; "RTN","DGRP9",24,0) DIS ;Display income "RTN","DGRP9",25,0) D MTCHK "RTN","DGRP9",26,0) N DGBL "RTN","DGRP9",27,0) W !!?34,"Veteran" W:DGSP ?46,"Spouse" W:DGDEP ?56,"Dependents" W ?73,"Total" "RTN","DGRP9",28,0) W !?31,"-----------------------------------------------" "RTN","DGRP9",29,0) S DGGTOT=0,DGRPW=1 ;initialize grand total variable "RTN","DGRP9",30,0) S Z=1 D WW^DGRPV D FLD(.DGTOT,8,"Social Security (Not SSI)") "RTN","DGRP9",31,0) S Z=2 D WW^DGRPV D FLD(.DGTOT,9,"U.S. Civil Service") "RTN","DGRP9",32,0) S Z=3 D WW^DGRPV D FLD(.DGTOT,10,"U.S. Railroad Retirement") "RTN","DGRP9",33,0) S Z=4 D WW^DGRPV D FLD(.DGTOT,11,"Military Retirement") "RTN","DGRP9",34,0) S Z=5 D WW^DGRPV D FLD(.DGTOT,12,"Unemployment Compensation") "RTN","DGRP9",35,0) S Z=6 D WW^DGRPV D FLD(.DGTOT,13,"Other Retirement") "RTN","DGRP9",36,0) S Z=7 D WW^DGRPV D FLD(.DGTOT,14,"Total Employment Income") "RTN","DGRP9",37,0) S Z=8 D WW^DGRPV D FLD(.DGTOT,15,"Interest,Dividend,Annuity") "RTN","DGRP9",38,0) S Z=9 D WW^DGRPV D FLD(.DGTOT,16,"Workers Comp or Black Lung") "RTN","DGRP9",39,0) S Z=10 D WW^DGRPV D FLD(.DGTOT,17,"All Other Income") "RTN","DGRP9",40,0) W !,DGBL,DGBL," Total 1-10 -->"," ",$J($$AMT^DGMTSCU1(DGGTOT),12) "RTN","DGRP9",41,0) ; "RTN","DGRP9",42,0) ;** Patch DG*5.3*108; estimated household income follows "RTN","DGRP9",43,0) W !!,DGISYR_" Estimated ""Household"" Taxable Income: "_$S($P(DGTOT("V"),U,21)'="":$$AMT^DGMTSCU1($P(DGTOT("V"),U,21)),1:"") "RTN","DGRP9",44,0) Q "RTN","DGRP9",45,0) ; "RTN","DGRP9",46,0) FLD(DGIN,DGPCE,DGTXT) ;Display inc. fields "RTN","DGRP9",47,0) ; Input: "RTN","DGRP9",48,0) ; DGIN 0 node of #408.21 for vet,spouse, and deps "RTN","DGRP9",49,0) ; DGRPCE as piece "RTN","DGRP9",50,0) ; DGTXT as income desc. "RTN","DGRP9",51,0) ; DGGTOT - If defined keeps running total "RTN","DGRP9",52,0) N DGTOT,I "RTN","DGRP9",53,0) I '$D(DGBL) S $P(DGBL," ",26)="" "RTN","DGRP9",54,0) W:Z'["10" " " "RTN","DGRP9",55,0) W " ",DGTXT,$P(DGBL," ",$L(DGTXT),26) "RTN","DGRP9",56,0) W $J($$AMT^DGMTSCU1($P(DGIN("V"),"^",DGPCE)),10) "RTN","DGRP9",57,0) W " ",$S($D(DGIN("S")):$J($$AMT^DGMTSCU1($P(DGIN("S"),"^",DGPCE)),10),1:$E(DGBL,1,10)) "RTN","DGRP9",58,0) W " ",$S($D(DGIN("D")):$J($$AMT^DGMTSCU1($P(DGIN("D"),"^",DGPCE)),11),1:$E(DGBL,1,11)) "RTN","DGRP9",59,0) S DGTOT="",I="" F S I=$O(DGIN(I)) Q:I="" I $P(DGIN(I),"^",DGPCE)]"" S DGTOT=DGTOT+$P(DGIN(I),"^",DGPCE) "RTN","DGRP9",60,0) W " ",$J($$AMT^DGMTSCU1(DGTOT),12) "RTN","DGRP9",61,0) I $D(DGGTOT) S DGGTOT=DGGTOT+DGTOT "RTN","DGRP9",62,0) Q "RTN","DGRP9",63,0) ; "RTN","DGRP9",64,0) TOT(DGINC,DGDOEXP) ; Totals income "RTN","DGRP9",65,0) ; Input "RTN","DGRP9",66,0) ; DGINC(x,ct) where X is V, S, or D and CT(counter)(per ALL^DGMTU21) "RTN","DGRP9",67,0) ; DGDOEXP: IF =1 TOTAL EXPENSE "RTN","DGRP9",68,0) ; "RTN","DGRP9",69,0) ;Output "RTN","DGRP9",70,0) ; DGTOT(x) where x is V, S, or D and DGTOT(x) = 0 node of #408.21 "RTN","DGRP9",71,0) ; (totaled if x is D...total of all deps) "RTN","DGRP9",72,0) ; "RTN","DGRP9",73,0) N DGCT,NODE,PIECE "RTN","DGRP9",74,0) S DGDOEXP=$G(DGDOEXP) "RTN","DGRP9",75,0) S DGTOT("V")="" "RTN","DGRP9",76,0) F DGTYPE="V","S","D" I $D(DGREL(DGTYPE)) S DGTOT(DGTYPE)="" D "RTN","DGRP9",77,0) . S:DGDOEXP&("VS"[DGTYPE) DGEXP(DGTYPE)=$$GET1ND(+$G(DGINC(DGTYPE))) "RTN","DGRP9",78,0) . I "VS"[DGTYPE S DGTOT(DGTYPE)=$$GET0ND(+$G(DGINC(DGTYPE))) Q "RTN","DGRP9",79,0) . F DGCT=0:0 S DGCT=$O(DGINC(DGTYPE,DGCT)) Q:'DGCT D "RTN","DGRP9",80,0) . . S:DGDOEXP DGEXP(DGTYPE)=$$GET1ND(+$G(DGINC(DGTYPE,DGCT))) "RTN","DGRP9",81,0) . . S NODE=$$GET0ND(+DGINC(DGTYPE,DGCT)) "RTN","DGRP9",82,0) . . F PIECE=8:1:17 I $P(NODE,"^",PIECE)]"" S $P(DGTOT("D"),"^",PIECE)=$P(DGTOT("D"),"^",PIECE)+$P(NODE,"^",PIECE) "RTN","DGRP9",83,0) Q "RTN","DGRP9",84,0) ; "RTN","DGRP9",85,0) GET0ND(IEN) ; Returns the 0 node of File #408.21 "RTN","DGRP9",86,0) Q $G(^DGMT(408.21,IEN,0)) "RTN","DGRP9",87,0) ; "RTN","DGRP9",88,0) GET1ND(IEN) ; Returns the 1 node of file #408.21 "RTN","DGRP9",89,0) Q $G(^DGMT(408.21,IEN,1)) "RTN","DGRP9",90,0) ; "RTN","DGRP9",91,0) MTCHK ; Checks if MT/CP is complete for prior calendar year "RTN","DGRP9",92,0) ; Input: "RTN","DGRP9",93,0) ; DFN "RTN","DGRP9",94,0) ; DGINR array of income relation for deps "RTN","DGRP9",95,0) ; DGISYR as income screening year "RTN","DGRP9",96,0) ;Output: "RTN","DGRP9",97,0) ; DGMTC as MT complete flag (1= yes,2=Non-Mt'd deps exist, 0 o/w) "RTN","DGRP9",98,0) ; DGMTC("S")= Mt complete, but spouse not MTed "RTN","DGRP9",99,0) ; DGMTC("D")= Mt complete, but at least one dep not MT'D "RTN","DGRP9",100,0) ; $D(DGMTED(X,X) if can't edit MT data "RTN","DGRP9",101,0) ; "RTN","DGRP9",102,0) N DGFL,DGHD,DGMTYPT,DGMTCP,I,X "RTN","DGRP9",103,0) S (DGFL,DGMTC)=0 ;initialize flag to 0 "RTN","DGRP9",104,0) S DGHD="Income data for "_DGISYR_". " "RTN","DGRP9",105,0) I $P($G(^DGMT(408.21,+$G(DGINC("V")),0)),U,18) S DGHD=DGHD_" [Data Copied - Not Updated]" "RTN","DGRP9",106,0) I '$$MTCOMP^DGRPU(DFN,DGEFDT) W !?(40-($L(DGHD)/2)),DGHD Q ; CP/MT not complete "RTN","DGRP9",107,0) S DGMTCP=$S(DGMTYPT=1:"Means",1:"Copay") "RTN","DGRP9",108,0) S DGMTC=1,DGRPVV(9)="1111111111",DGMTED("V")=1 S DGHD=DGHD_DGMTCP_" Test is complete for that calendar year!" "RTN","DGRP9",109,0) W !?(40-($L(DGHD)/2)),DGHD "RTN","DGRP9",110,0) G:DGEFDT'=DT MTCKQT ;NO EDITING AT ALL FOR LAST YEAR "RTN","DGRP9",111,0) I $D(DGREL("S")) S DGFL=1 I +$G(^DGMT(408.22,+$G(DGINR("S")),"MT")) S DGMTED("S")=1,DGFL=0 "RTN","DGRP9",112,0) I DGFL S DGMTC("S")=1 S DGFL=0 "RTN","DGRP9",113,0) F I=0:0 S I=$O(DGREL("D",I)) Q:'I S X=+$G(^DGMT(408.22,+$G(DGINR("D",I)),"MT")) S:X DGMTED("D",I)=1 I 'X S DGFL=1 "RTN","DGRP9",114,0) I DGFL S DGMTC("D")=1 "RTN","DGRP9",115,0) I $D(DGMTC("S"))!$D(DGMTC("D")) W !,*7," You can only edit these items for dependents who are not not "_DGMTCP_" tested!" S DGMTC=2,DGRPVV(9)="0000000000" Q "RTN","DGRP9",116,0) W !,*7,?12,"This data must be edited through the "_DGMTCP_" test module!" "RTN","DGRP9",117,0) MTCKQT Q "VER") 8.0^22.0 **END** **END**