Released DG*5.3*703 SEQ #617 Extracted from mail message **KIDS**:DG*5.3*703^ **INSTALL NAME** DG*5.3*703 "BLD",6566,0) DG*5.3*703^REGISTRATION^0^3060411^y "BLD",6566,4,0) ^9.64PA^^0 "BLD",6566,"KRN",0) ^9.67PA^8989.52^19 "BLD",6566,"KRN",.4,0) .4 "BLD",6566,"KRN",.401,0) .401 "BLD",6566,"KRN",.402,0) .402 "BLD",6566,"KRN",.403,0) .403 "BLD",6566,"KRN",.5,0) .5 "BLD",6566,"KRN",.84,0) .84 "BLD",6566,"KRN",3.6,0) 3.6 "BLD",6566,"KRN",3.8,0) 3.8 "BLD",6566,"KRN",9.2,0) 9.2 "BLD",6566,"KRN",9.8,0) 9.8 "BLD",6566,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",6566,"KRN",9.8,"NM",1,0) DGRPD^^0^B65212310 "BLD",6566,"KRN",9.8,"NM",2,0) DGRPD1^^0^B5093592 "BLD",6566,"KRN",9.8,"NM","B","DGRPD",1) "BLD",6566,"KRN",9.8,"NM","B","DGRPD1",2) "BLD",6566,"KRN",19,0) 19 "BLD",6566,"KRN",19.1,0) 19.1 "BLD",6566,"KRN",101,0) 101 "BLD",6566,"KRN",409.61,0) 409.61 "BLD",6566,"KRN",771,0) 771 "BLD",6566,"KRN",870,0) 870 "BLD",6566,"KRN",8989.51,0) 8989.51 "BLD",6566,"KRN",8989.52,0) 8989.52 "BLD",6566,"KRN",8994,0) 8994 "BLD",6566,"KRN","B",.4,.4) "BLD",6566,"KRN","B",.401,.401) "BLD",6566,"KRN","B",.402,.402) "BLD",6566,"KRN","B",.403,.403) "BLD",6566,"KRN","B",.5,.5) "BLD",6566,"KRN","B",.84,.84) "BLD",6566,"KRN","B",3.6,3.6) "BLD",6566,"KRN","B",3.8,3.8) "BLD",6566,"KRN","B",9.2,9.2) "BLD",6566,"KRN","B",9.8,9.8) "BLD",6566,"KRN","B",19,19) "BLD",6566,"KRN","B",19.1,19.1) "BLD",6566,"KRN","B",101,101) "BLD",6566,"KRN","B",409.61,409.61) "BLD",6566,"KRN","B",771,771) "BLD",6566,"KRN","B",870,870) "BLD",6566,"KRN","B",8989.51,8989.51) "BLD",6566,"KRN","B",8989.52,8989.52) "BLD",6566,"KRN","B",8994,8994) "BLD",6566,"QUES",0) ^9.62^^ "BLD",6566,"REQB",0) ^9.611^1^1 "BLD",6566,"REQB",1,0) DG*5.3*677^2 "BLD",6566,"REQB","B","DG*5.3*677",1) "MBREQ") 0 "PKG",114,-1) 1^1 "PKG",114,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",114,20,0) ^9.402P^^ "PKG",114,22,0) ^9.49I^1^1 "PKG",114,22,1,0) 5.3^2930813^2930821 "PKG",114,22,1,"PAH",1,0) 703^3060411 "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","DGRPD") 0^1^B65212310^B63244207 "RTN","DGRPD",1,0) DGRPD ;ALB/MRL/MLR/JAN/LBD/EG/BRM/JRC-PATIENT INQUIRY (NEW) ; 3/9/06 11:17am "RTN","DGRPD",2,0) ;;5.3;Registration;**109,124,121,57,161,149,286,358,436,445,489,498,506,513,518,550,545,568,585,677,703**;Aug 13, 1993 "RTN","DGRPD",3,0) ; *286* Newing variables X,Y in OKLINE subroutine "RTN","DGRPD",4,0) ; *358* If a patient is on a domiciliary ward, don't display MEANS "RTN","DGRPD",5,0) ; TEST required/Medication Copayment Exemption messages "RTN","DGRPD",6,0) ; *436* If an inpatient is not on a domiciliary ward, don't display "RTN","DGRPD",7,0) ; Medication Copayment Exemption message "RTN","DGRPD",8,0) ; *545* Add death information near the remarks field "RTN","DGRPD",9,0) ; *677* Added Emergency Response "RTN","DGRPD",10,0) SEL K DFN,DGRPOUT W ! S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S DFN=+Y N Y W ! S DIR(0)="E" D ^DIR G SEL:$D(DTOUT)!($D(DUOUT)) D EN G SEL "RTN","DGRPD",11,0) EN ;call to display patient inquiry - input DFN "RTN","DGRPD",12,0) ;MPI/PD CHANGE "RTN","DGRPD",13,0) S DGCMOR="UNSPECIFIED",DGMPI=$G(^DPT(+DFN,"MPI")) "RTN","DGRPD",14,0) S DGLOCATN=$$FIND1^DIC(4,"","MX","`"_+$P(DGMPI,U,3)),DGLOCATN=$S(+DGLOCATN>0:$P($$NS^XUAF4(DGLOCATN),U),1:"NOT LISTED") "RTN","DGRPD",15,0) I $D(DGMPI),$D(DGLOCATN) S DGCMOR=$P(DGLOCATN,"^") "RTN","DGRPD",16,0) ;END MPI/PD CHANGE "RTN","DGRPD",17,0) K DGRPOUT,DGHOW S DGABBRV=$S($D(^DG(43,1,0)):+$P(^(0),"^",38),1:0),DGRPU="UNSPECIFIED" D DEM^VADPT,HDR F I=0,.11,.13,.121,.31,.32,.36,.361,.141,.3 S DGRP(I)=$S($D(^DPT(DFN,I)):^(I),1:"") "RTN","DGRPD",18,0) S DGAD=.11,(DGA1,DGA2)=1 D A^DGRPU S DGTMPAD=0 I $P(DGRP(.121),"^",9)="Y" S DGTMPAD=$S('$P(DGRP(.121),"^",8):1,$P(DGRP(.121),"^",8)'50) !?10 W:'(I#2) ?51 W DGA(I) "RTN","DGRPD",21,0) S DGCC=+$P(DGRP(.11),U,7),DGST=+$P(DGRP(.11),U,5),DGCC=$S($D(^DIC(5,DGST,1,DGCC,0)):$E($P(^(0),U,1),1,20)_$S($P(^(0),U,3)]"":" ("_$P(^(0),U,3)_")",1:""),1:DGRPU) W !?2,"County: ",DGCC "RTN","DGRPD",22,0) S X="NOT APPLICABLE" I DGTMPAD S Y=$P(DGRP(.121),U,7) X:Y]"" ^DD("DD") S X=$S(Y]"":Y,1:DGRPU)_"-",Y=$P(DGRP(.121),U,8) X:Y]"" ^DD("DD") S X=X_$S(Y]"":Y,1:DGRPU) "RTN","DGRPD",23,0) W ?42,"From/To: ",X,!?3,"Phone: ",$S($P(DGRP(.13),U,1)]"":$P(DGRP(.13),U,1),1:DGRPU),?44,"Phone: ",$S('DGTMPAD:X,$P(DGRP(.121),U,10)]"":$P(DGRP(.121),U,10),1:DGRPU) K DGTMPAD "RTN","DGRPD",24,0) W !?2,"Office: ",$S($P(DGRP(.13),U,2)]"":$P(DGRP(.13),U,2),1:DGRPU) "RTN","DGRPD",25,0) W !?4,"Cell: ",$S($P(DGRP(.13),U,4)]"":$P(DGRP(.13),U,4),1:DGRPU) "RTN","DGRPD",26,0) W !?2,"E-mail: ",$S($P(DGRP(.13),U,3)]"":$P(DGRP(.13),U,3),1:DGRPU) "RTN","DGRPD",27,0) W !,"Bad Addr: ",$$EXTERNAL^DILFD(2,.121,"",$$BADADR^DGUTL3(+DFN)) "RTN","DGRPD",28,0) D CA "RTN","DGRPD",29,0) N DGEMER S DGEMER=$$EXTERNAL^DILFD(2,.181,"",$P($G(^DPT(DFN,.18)),"^")) "RTN","DGRPD",30,0) W:DGEMER]"" !?32,"Emergency Response: ",DGEMER "RTN","DGRPD",31,0) I 'DGABBRV W !!?4,"POS: ",$S($D(^DIC(21,+$P(DGRP(.32),"^",3),0)):$P(^(0),"^",1),1:DGRPU),?42,"Claim #: ",$S($P(DGRP(.31),"^",3)]"":$P(DGRP(.31),"^",3),1:"UNSPECIFIED") "RTN","DGRPD",32,0) I 'DGABBRV W !?2,"Relig: ",$S($D(^DIC(13,+$P(DGRP(0),"^",8),0)):$P(^(0),"^",1),1:DGRPU),?46,"Sex: ",$S($P(VADM(5),"^",2)]"":$P(VADM(5),"^",2),1:"UNSPECIFIED") "RTN","DGRPD",33,0) I 'DGABBRV W ! D "RTN","DGRPD",34,0) .N RACE,ETHNIC,PTR,VAL,X,DIWL,DIWR,DIWF "RTN","DGRPD",35,0) .K ^UTILITY($J,"W") "RTN","DGRPD",36,0) .S PTR=0 F S PTR=+$O(^DPT(DFN,.02,PTR)) Q:'PTR D "RTN","DGRPD",37,0) ..S VAL=+$G(^DPT(DFN,.02,PTR,0)) "RTN","DGRPD",38,0) ..Q:$$INACTIVE^DGUTL4(VAL,1) "RTN","DGRPD",39,0) ..S VAL=$$PTR2TEXT^DGUTL4(VAL,1) S:+$O(^DPT(DFN,.02,PTR)) VAL=VAL_", " "RTN","DGRPD",40,0) ..S X=VAL,DIWL=0,DIWR=30,DIWF="" D ^DIWP "RTN","DGRPD",41,0) .M RACE=^UTILITY($J,"W",0) S:$G(RACE(1,0))="" RACE(1,0)="UNANSWERED" "RTN","DGRPD",42,0) .K ^UTILITY($J,"W") "RTN","DGRPD",43,0) .S PTR=0 F S PTR=+$O(^DPT(DFN,.06,PTR)) Q:'PTR D "RTN","DGRPD",44,0) ..S VAL=+$G(^DPT(DFN,.06,PTR,0)) "RTN","DGRPD",45,0) ..Q:$$INACTIVE^DGUTL4(VAL,2) "RTN","DGRPD",46,0) ..S VAL=$$PTR2TEXT^DGUTL4(VAL,2) S:+$O(^DPT(DFN,.06,PTR)) VAL=VAL_", " "RTN","DGRPD",47,0) ..S X=VAL,DIWL=0,DIWR=30,DIWF="" D ^DIWP "RTN","DGRPD",48,0) .M ETHNIC=^UTILITY($J,"W",0) S:$G(ETHNIC(1,0))="" ETHNIC(1,0)="UNANSWERED" "RTN","DGRPD",49,0) .K ^UTILITY($J,"W") "RTN","DGRPD",50,0) .W ?3,"Race: ",RACE(1,0),?40,"Ethnicity: ",ETHNIC(1,0) "RTN","DGRPD",51,0) .F X=2:1 Q:'$D(RACE(X,0))&'$D(ETHNIC(X,0)) W !,?9,$G(RACE(X,0)),?51,$G(ETHNIC(X,0)) "RTN","DGRPD",52,0) I '$$OKLINE(16) G Q "RTN","DGRPD",53,0) ;display cv status #4156 "RTN","DGRPD",54,0) N DGCV S DGCV=$$CVEDT^DGCV(+DFN) "RTN","DGRPD",55,0) W !!,?2,"Combat Vet Status: "_$S($P(DGCV,U,3)=1:"ELIGIBLE",$P(DGCV,U,3)="":"NOT ELIGIBLE",1:"EXPIRED") I DGCV>0 W ?45,"End Date: "_$$FMTE^XLFDT($P(DGCV,U,2),"5DZ") "RTN","DGRPD",56,0) ;display primary eligibility "RTN","DGRPD",57,0) S X1=DGRP(.36),X=$P(DGRP(.361),"^",1) W !,"Primary Eligibility: ",$S($D(^DIC(8,+X1,0)):$P(^(0),"^",1)_" ("_$S(X="V":"VERIFIED",X="P":"PENDING VERIFICATION",X="R":"PENDING REVERIFICATION",1:"NOT VERIFIED")_")",1:DGRPU) "RTN","DGRPD",58,0) W !,"Other Eligibilities: " F I=0:0 S I=$O(^DIC(8,I)) Q:'I I $D(^DIC(8,I,0)),I'=+X1 S X=$P(^(0),"^",1)_", " I $D(^DPT("AEL",DFN,I)) W:$X+$L(X)>79 !?21 W X "RTN","DGRPD",59,0) I '$$OKLINE(16) G Q "RTN","DGRPD",60,0) ;employability status "RTN","DGRPD",61,0) W !?6,"Unemployable: ",$S($P(DGRP(.3),U,5)="Y":"YES",1:"NO") "RTN","DGRPD",62,0) ;display the catastrophic disability review date if there is one "RTN","DGRPD",63,0) D CATDIS^DGRPD1 "RTN","DGRPD",64,0) I $G(DGPRFLG)=1 G Q:'$$OKLINE(19) D "RTN","DGRPD",65,0) . N DGPDT,DGPTM "RTN","DGRPD",66,0) . W !,$$REPEAT^XLFSTR("-",78) "RTN","DGRPD",67,0) . S DGPDT="",DGPDT=$O(^DGS(41.41,"ADC",DFN,DGPDT),-1) "RTN","DGRPD",68,0) . W !,"[PRE-REGISTER DATE:] "_$S(DGPDT]"":$$FMTE^XLFDT(DGPDT,"1D"),1:"NONE ON FILE") "RTN","DGRPD",69,0) . S DGPTM=$$PCTEAM^DGSDUTL(DFN) "RTN","DGRPD",70,0) . I $P(DGPTM,U,2)]"" W !,"[PRIMARY CARE TEAM:] "_$P(DGPTM,U,2) "RTN","DGRPD",71,0) . W !,$$REPEAT^XLFSTR("-",78) "RTN","DGRPD",72,0) ; Check if patient is an inpatient and on a DOM ward "RTN","DGRPD",73,0) ; If inpatient is on a DOM ward, don't display MT or CP messages "RTN","DGRPD",74,0) ; If inpatient is NOT on a DOM ward, don't display CP message "RTN","DGRPD",75,0) N DGDOM,DGDOM1,VAHOW,VAROOT,VAINDT,VAIP,VAERR "RTN","DGRPD",76,0) G Q:'$$OKLINE(14) "RTN","DGRPD",77,0) D DOM^DGMTR "RTN","DGRPD",78,0) I '$G(DGDOM) D "RTN","DGRPD",79,0) .D DIS^DGMTU(DFN) "RTN","DGRPD",80,0) .D IN5^VADPT "RTN","DGRPD",81,0) .I $G(VAIP(1))="" D DISP^IBARXEU(DFN,DT,3,1) "RTN","DGRPD",82,0) ;I 'DGABBRV,$E(IOST,1,2)="C-" F I=$Y:1:20 W ! "RTN","DGRPD",83,0) D DIS^EASECU(DFN) ;Added for LTC III (DG*5.3*518) "RTN","DGRPD",84,0) S VAIP("L")="" "RTN","DGRPD",85,0) I $$OKLINE(14) D INP "RTN","DGRPD",86,0) I '$G(DGRPOUT),($$OKLINE(17)) D SA "RTN","DGRPD",87,0) ;MPI/PD CHANGE "RTN","DGRPD",88,0) Q D KVA^VADPT K %DT,D0,D1,DGA,DGA1,DGA2,DGABBRV,DGAD,DGCC,DGCMOR,DGDOM,DGLOCATN,DGMPI,DGRP,DGRPU,DGS,DGST,DGXFR0,DIC,DIR,DTOUT,DUOUT,DIRUT,DIROUT,I,I1,L,LDM,POP,SDCT,VA,X,X1,Y Q "RTN","DGRPD",89,0) CA ;Confidential Address "RTN","DGRPD",90,0) W !!?1,"Confidential Address: ",?44,"Confidential Address Categories:" "RTN","DGRPD",91,0) N DGCABEG,DGCAEND,DGA,DGARRAY,DGERROR "RTN","DGRPD",92,0) S DGCABEG=$P(DGRP(.141),U,7),DGCAEND=$P(DGRP(.141),U,8) "RTN","DGRPD",93,0) I 'DGCABEG!(DGCABEG>DT)!(DGCAEND&(DGCAEND43) !?9 W:'(I#2) ?44 W DGA(I) "RTN","DGRPD",109,0) W !?1,"From/To: ",$$FMTE^XLFDT(DGCABEG)_"-"_$S(DGCAEND'="":$$FMTE^XLFDT(DGCAEND),1:"UNANSWERED") "RTN","DGRPD",110,0) Q "RTN","DGRPD",111,0) HDR I '$D(IOF) S IOP="HOME" D ^%ZIS K IOP "RTN","DGRPD",112,0) ;MPI/PD CHANGE "RTN","DGRPD",113,0) W @IOF,!,$P(VADM(1),"^",1),?40,$P(VADM(2),"^",2),?65,$P(VADM(3),"^",2) S X="",$P(X,"=",78)="" W !,X,!?15,"COORDINATING MASTER OF RECORD: ",DGCMOR,! Q "RTN","DGRPD",114,0) ;END MPI/PD CHANGE "RTN","DGRPD",115,0) INP S VAIP("D")="L" D INP^DGPMV10 "RTN","DGRPD",116,0) S DGPMT=0 "RTN","DGRPD",117,0) D CS^DGPMV10 K DGPMT,DGPMIFN K:'$D(DGSWITCH) DGPMVI,DGPMDCD Q "RTN","DGRPD",118,0) SA F I=0:0 S I=$O(^DGS(41.1,"B",DFN,I)) G CL:'I S X=^DGS(41.1,I,0) I $P(X,"^",2)>(DT-1),$P(X,"^",13)']"",'$P(X,"^",17) S L=$P(X,"^",2) D:$$OKLINE(17) SAA Q:$G(DGRPOUT) "RTN","DGRPD",119,0) Q "RTN","DGRPD",120,0) SAA ;Scheduled Admit Data "RTN","DGRPD",121,0) W !!?14,"Scheduled Admit" "RTN","DGRPD",122,0) W:$D(^DIC(42,+$P(X,U,8),0)) " on ward "_$P(^(0),U) "RTN","DGRPD",123,0) W:$D(^DIC(45.7,+$P(X,U,9),0)) " for treating specialty "_$P(^(0),U) "RTN","DGRPD",124,0) W " on "_$$FMTE^XLFDT(L,"5DZ") "RTN","DGRPD",125,0) Q ;SAA "RTN","DGRPD",126,0) ; "RTN","DGRPD",127,0) CL G FA:$O(^DPT(DFN,"DE",0))="" S SDCT=0 F I=0:0 S I=$O(^DPT(DFN,"DE",I)) Q:'I I $D(^(I,0)),$P(^(0),"^",2)'="I",$O(^(0)) S SDCT=SDCT+1 W:SDCT=1 !!,"Currently enrolled in " W:$X>50 !?22 W $S($D(^SC(+^(0),0)):$P(^(0),"^",1)_", ",1:"") "RTN","DGRPD",128,0) ; "RTN","DGRPD",129,0) FA G:'$$OKLINE(20) RMK "RTN","DGRPD",130,0) ; "RTN","DGRPD",131,0) N DGARRAY,SDCNT "RTN","DGRPD",132,0) S DGARRAY("FLDS")="1;2;3;18",DGARRAY(4)=DFN,DGARRAY(1)=DT,DGARRAY("SORT")="P" "RTN","DGRPD",133,0) S SDCNT=$$SDAPI^SDAMA301(.DGARRAY),CT=0 W !!,"Future Appointments: " "RTN","DGRPD",134,0) ;if there is lower subscripts hanging from the 101 node, "RTN","DGRPD",135,0) ;then it is a valid appointment, otherwise it is "RTN","DGRPD",136,0) ;an error eg 01/20/2005 "RTN","DGRPD",137,0) I $D(^TMP($J,"SDAMA301",101))=1 W "Appointment Database is Unavailable" G RMK "RTN","DGRPD",138,0) I $O(^TMP($J,"SDAMA301",DFN,DT))'>0 W "NONE" G RMK "RTN","DGRPD",139,0) ; "RTN","DGRPD",140,0) W ?22,"Date",?33,"Time",?39,"Clinic",!?22 F I=22:1:75 W "=" "RTN","DGRPD",141,0) F FA=DT:0 S FA=$O(^TMP($J,"SDAMA301",DFN,FA)) G RMK:'FA D Q:CT>5 "RTN","DGRPD",142,0) .N STAT S STAT=$P($P(^TMP($J,"SDAMA301",DFN,FA),U,3),";") "RTN","DGRPD",143,0) .S C=+$P(^TMP($J,"SDAMA301",DFN,FA),U,2) I STAT'["C" D "RTN","DGRPD",144,0) ..D COV "RTN","DGRPD",145,0) ..N DGAPPT S DGAPPT=$$FMTE^XLFDT($E(FA,1,12),"5Z") "RTN","DGRPD",146,0) ..W !?22,$P(DGAPPT,"@"),?33,$P(DGAPPT,"@",2) "RTN","DGRPD",147,0) ..W ?39,$P($P(^TMP($J,"SDAMA301",DFN,FA),U,2),";",2)," ",COV "RTN","DGRPD",148,0) ..Q "RTN","DGRPD",149,0) I $O(^TMP($J,"SDAMA301",DFN,FA))>0 W !,"See Scheduling options for additional appointments." "RTN","DGRPD",150,0) RMK I '$G(DGRPOUT),($$OKLINE(21)) W !!,"Remarks: ",$P(^DPT(DFN,0),"^",10) "RTN","DGRPD",151,0) D GETS^DIQ(2,DFN_",",".351;.353;.354;.355","E","PDTHINFO") "RTN","DGRPD",152,0) W !! "RTN","DGRPD",153,0) W "Date of Death Information" "RTN","DGRPD",154,0) W !,?5,"Date of Death: ",$G(PDTHINFO(2,DFN_",",.351,"E")) "RTN","DGRPD",155,0) W !,?5,"Source of Notification: ",$G(PDTHINFO(2,DFN_",",.353,"E")) "RTN","DGRPD",156,0) W !,?5,"Updated Date/Time: ",$G(PDTHINFO(2,DFN_",",.354,"E")) "RTN","DGRPD",157,0) W !,?5,"Last Edited By: ",$G(PDTHINFO(2,DFN_",",.355,"E")),! "RTN","DGRPD",158,0) I $$OKLINE(14) D EC^DGRPD1 "RTN","DGRPD",159,0) K DGARRAY,SDCNT,^TMP($J,"SDAMA301"),ADM,L,TRN,DIS,SSN,FA,C,COV,NOW,CT,DGD,DGD1,I ;Y killed after dghinqky "RTN","DGRPD",160,0) Q "RTN","DGRPD",161,0) COV S COV=$S(+$P(^TMP($J,"SDAMA301",DFN,FA),U,18)=7:" (Collateral) ",1:"") "RTN","DGRPD",162,0) S COV=COV_$S(STAT["NT":" * NO ACTION TAKEN *",STAT["N":" * NO-SHOW *",1:""),CT=CT+1 Q "RTN","DGRPD",163,0) Q "RTN","DGRPD",164,0) ; "RTN","DGRPD",165,0) OREN S XQORQUIT=1 Q:'$D(ORVP) S DFN=+ORVP D EN R !!,"Press RETURN to CONTINUE: ",X:DTIME "RTN","DGRPD",166,0) Q "RTN","DGRPD",167,0) OKLINE(DGLINE) ;DOES PAUSE/HEADER IF $Y EXCEEDS DGLINE "RTN","DGRPD",168,0) ; "RTN","DGRPD",169,0) ;IN: DGLINE --MAX LINE COUNT W/O PAUSE "RTN","DGRPD",170,0) ;OUT: DGLINE[RETURNED] -- 0 IF TIMEOUT/UP ARROW "RTN","DGRPD",171,0) ; DGRPOUT[SET] -- 1 IF " "RTN","DGRPD",172,0) N X,Y ;**286** MLR 09/25/00 Newing X & Y variables prior to ^DIR "RTN","DGRPD",173,0) I $G(IOST)["P-" Q DGLINE ; if printer, quit "RTN","DGRPD",174,0) I $Y>DGLINE N DIR S DIR(0)="E" D ^DIR D:Y HDR I 'Y S DGRPOUT=1,DGLINE=0 "RTN","DGRPD",175,0) Q DGLINE "RTN","DGRPD",176,0) ; "RTN","DGRPD1") 0^2^B5093592 "RTN","DGRPD1",1,0) DGRPD1 ;BPFO/JRC - PATIENT INQUIRY (NEW) ; 4/11/06 9:30am "RTN","DGRPD1",2,0) ;;5.3;Registration;**703**;Aug 13, 1993 "RTN","DGRPD1",3,0) Q "RTN","DGRPD1",4,0) EC ;display emergency contact information "RTN","DGRPD1",5,0) N DGEC1,DGEC2 "RTN","DGRPD1",6,0) Q:'$G(DFN) "RTN","DGRPD1",7,0) S VAOA("A")=1,VAROOT="DGEC1" D OAD^VADPT ; Get Primary EC "RTN","DGRPD1",8,0) S VAOA("A")=4,VAROOT="DGEC2" D OAD^VADPT ; Get Secondary EC "RTN","DGRPD1",9,0) I DGEC1(9)]"" D "RTN","DGRPD1",10,0) . W !,"Emergency Contact Information:" "RTN","DGRPD1",11,0) . ;Contacts name and realtionship "RTN","DGRPD1",12,0) . W !?5,"E-Cont.: ",DGEC1(9) "RTN","DGRPD1",13,0) . I DGEC2(9)]"" W ?40,"E2-Cont.: ",DGEC2(9) "RTN","DGRPD1",14,0) . W !,"Relationship: ",DGEC1(10) "RTN","DGRPD1",15,0) . I DGEC2(9)]"" W ?36,"Relationship: ",DGEC2(10) "RTN","DGRPD1",16,0) . ;ECs address lines 1, 2 and 3 "RTN","DGRPD1",17,0) . I DGEC1(1)]"" W !?14,DGEC1(1) "RTN","DGRPD1",18,0) . I DGEC1(1)']"",DGEC2(1)]"" W ! "RTN","DGRPD1",19,0) . I DGEC2(1)]"" W ?50,DGEC2(1) "RTN","DGRPD1",20,0) . I DGEC1(2)]"" W !?14,DGEC1(2) "RTN","DGRPD1",21,0) . I DGEC1(2)']"",DGEC2(2)]"" W ! "RTN","DGRPD1",22,0) . I DGEC2(2)]"" W ?50,DGEC2(2) "RTN","DGRPD1",23,0) . I DGEC1(3)]"" W !?14,DGEC1(3) "RTN","DGRPD1",24,0) . I DGEC1(3)']"",DGEC2(3)]"" W ! "RTN","DGRPD1",25,0) . I DGEC2(3)]"" W ?50,DGEC2(3) "RTN","DGRPD1",26,0) . ;Emergency Contact 1 City, State an Zip+4 "RTN","DGRPD1",27,0) . I DGEC1(4)]"" D "RTN","DGRPD1",28,0) . . W !?14,DGEC1(4) "RTN","DGRPD1",29,0) . . I DGEC1(5)]"" W ", "_$$GET1^DIQ(5,+DGEC1(5),1) "RTN","DGRPD1",30,0) . . W " ",$P(DGEC1(11),"^",2) "RTN","DGRPD1",31,0) . ;Emergency Contact 2 City State and Zip+4 "RTN","DGRPD1",32,0) . I DGEC2(4)]"" D "RTN","DGRPD1",33,0) . . I DGEC1(4)']"" W ! "RTN","DGRPD1",34,0) . . W ?50,DGEC2(4) "RTN","DGRPD1",35,0) . . I DGEC2(5)]"" W ", "_$$GET1^DIQ(5,+DGEC2(5),1) "RTN","DGRPD1",36,0) . . W " ",$P(DGEC2(11),"^",2) "RTN","DGRPD1",37,0) .;Home and work phones "RTN","DGRPD1",38,0) . W !,?7,"Phone: ",$S(DGEC1(8)]"":DGEC1(8),1:"UNSPECIFIED") "RTN","DGRPD1",39,0) . I DGEC2(9)]"" W ?43,"Phone: ",$S(DGEC2(8)]"":DGEC2(8),1:"UNSPECIFIED") "RTN","DGRPD1",40,0) . W !?2,"Work Phone: ",$S($P(^DPT(DFN,.33),U,11):$P(^(.33),U,11),1:"UNSPECIFIED") "RTN","DGRPD1",41,0) . I DGEC2(9)]"" W ?38,"Work Phone: ",$S($P(^DPT(DFN,.331),U,11):$P(^(.331),U,11),1:"UNSPECIFIED") "RTN","DGRPD1",42,0) D KVAR^VADPT "RTN","DGRPD1",43,0) Q "RTN","DGRPD1",44,0) ; "RTN","DGRPD1",45,0) CATDIS ; "RTN","DGRPD1",46,0) ;displays catastrophic disabity review date if there is one "RTN","DGRPD1",47,0) N DGCDIS "RTN","DGRPD1",48,0) Q:'$G(DFN) "RTN","DGRPD1",49,0) I $$GET^DGENCDA(DFN,.DGCDIS) D "RTN","DGRPD1",50,0) .Q:'DGCDIS("REVDTE") "RTN","DGRPD1",51,0) .W !!,"Catastrophically Disabled Review Date: ",$$FMTE^XLFDT(DGCDIS("REVDTE"),1) "RTN","DGRPD1",52,0) Q "RTN","DGRPD1",53,0) ; "VER") 8.0^22.0 "BLD",6566,6) ^617 **END** **END**