Released DG*5.3*574 SEQ #506 Extracted from mail message **KIDS**:DG*5.3*574^ **INSTALL NAME** DG*5.3*574 "BLD",5273,0) DG*5.3*574^REGISTRATION^0^3040202^y "BLD",5273,1,0) ^9.61A^1^1^3031211^^ "BLD",5273,1,1,0) Fixes assorted backlog NOIS calls. "BLD",5273,4,0) ^9.64PA^^ "BLD",5273,"INIT") DG53P574 "BLD",5273,"KRN",0) ^9.67PA^8989.52^19 "BLD",5273,"KRN",.4,0) .4 "BLD",5273,"KRN",.4,"NM",0) ^9.68A^^ "BLD",5273,"KRN",.401,0) .401 "BLD",5273,"KRN",.402,0) .402 "BLD",5273,"KRN",.403,0) .403 "BLD",5273,"KRN",.5,0) .5 "BLD",5273,"KRN",.84,0) .84 "BLD",5273,"KRN",3.6,0) 3.6 "BLD",5273,"KRN",3.8,0) 3.8 "BLD",5273,"KRN",9.2,0) 9.2 "BLD",5273,"KRN",9.8,0) 9.8 "BLD",5273,"KRN",9.8,"NM",0) ^9.68A^6^6 "BLD",5273,"KRN",9.8,"NM",1,0) DG10^^0^B18424351 "BLD",5273,"KRN",9.8,"NM",2,0) DGPREP1^^0^B35442672 "BLD",5273,"KRN",9.8,"NM",3,0) DGPMEVT^^0^B3870087 "BLD",5273,"KRN",9.8,"NM",4,0) DGREG^^0^B47358258 "BLD",5273,"KRN",9.8,"NM",5,0) DGREGFAC^^0^B466833 "BLD",5273,"KRN",9.8,"NM",6,0) DPTLK1^^0^B33727794 "BLD",5273,"KRN",9.8,"NM","B","DG10",1) "BLD",5273,"KRN",9.8,"NM","B","DGPMEVT",3) "BLD",5273,"KRN",9.8,"NM","B","DGPREP1",2) "BLD",5273,"KRN",9.8,"NM","B","DGREG",4) "BLD",5273,"KRN",9.8,"NM","B","DGREGFAC",5) "BLD",5273,"KRN",9.8,"NM","B","DPTLK1",6) "BLD",5273,"KRN",19,0) 19 "BLD",5273,"KRN",19,"NM",0) ^9.68A^^ "BLD",5273,"KRN",19.1,0) 19.1 "BLD",5273,"KRN",101,0) 101 "BLD",5273,"KRN",409.61,0) 409.61 "BLD",5273,"KRN",771,0) 771 "BLD",5273,"KRN",870,0) 870 "BLD",5273,"KRN",8989.51,0) 8989.51 "BLD",5273,"KRN",8989.52,0) 8989.52 "BLD",5273,"KRN",8994,0) 8994 "BLD",5273,"KRN","B",.4,.4) "BLD",5273,"KRN","B",.401,.401) "BLD",5273,"KRN","B",.402,.402) "BLD",5273,"KRN","B",.403,.403) "BLD",5273,"KRN","B",.5,.5) "BLD",5273,"KRN","B",.84,.84) "BLD",5273,"KRN","B",3.6,3.6) "BLD",5273,"KRN","B",3.8,3.8) "BLD",5273,"KRN","B",9.2,9.2) "BLD",5273,"KRN","B",9.8,9.8) "BLD",5273,"KRN","B",19,19) "BLD",5273,"KRN","B",19.1,19.1) "BLD",5273,"KRN","B",101,101) "BLD",5273,"KRN","B",409.61,409.61) "BLD",5273,"KRN","B",771,771) "BLD",5273,"KRN","B",870,870) "BLD",5273,"KRN","B",8989.51,8989.51) "BLD",5273,"KRN","B",8989.52,8989.52) "BLD",5273,"KRN","B",8994,8994) "BLD",5273,"PRE") DG53E574 "BLD",5273,"QUES",0) ^9.62^^ "BLD",5273,"REQB",0) ^9.611^4^4 "BLD",5273,"REQB",1,0) DG*5.3*136^1 "BLD",5273,"REQB",2,0) DG*5.3*425^1 "BLD",5273,"REQB",3,0) DG*5.3*533^1 "BLD",5273,"REQB",4,0) DG*5.3*532^1 "BLD",5273,"REQB","B","DG*5.3*136",1) "BLD",5273,"REQB","B","DG*5.3*425",2) "BLD",5273,"REQB","B","DG*5.3*532",4) "BLD",5273,"REQB","B","DG*5.3*533",3) "INIT") DG53P574 "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^2930813 "PKG",5,22,1,"PAH",1,0) 574^3040202^100850 "PKG",5,22,1,"PAH",1,1,0) ^^1^1^3040202 "PKG",5,22,1,"PAH",1,1,1,0) Fixes assorted backlog NOIS calls. "PRE") DG53E574 "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") 8 "RTN","DG10") 0^1^B18424351 "RTN","DG10",1,0) DG10 ;ALB/MRL,DAK,AEG-LOAD/EDIT PATIENT DATA ; 1/12/04 4:58pm "RTN","DG10",2,0) ;;5.3;Registration;**32,109,139,149,182,326,513,425,574**;Aug 13, 1993 "RTN","DG10",3,0) START ; "RTN","DG10",4,0) D LO^DGUTL "RTN","DG10",5,0) I $G(DGPRFLG)=1,$G(DGPLOC)=1 D G Q:$G(DGRPOUT),A1 "RTN","DG10",6,0) .; D EN^DGRPD,REG^IVMCQ($G(DFN)) "RTN","DG10",7,0) . D EN^DGRPD "RTN","DG10",8,0) . Q:$G(DGRPOUT) "RTN","DG10",9,0) . D REG^IVMCQ($G(DFN)) "RTN","DG10",10,0) . D HINQ "RTN","DG10",11,0) ; "RTN","DG10",12,0) A W !! K VET,DIE,DIC,CARD S DIC=2,DLAYGO=2,DIC(0)="ALEQM" K DIC("S") D ^DIC G Q:Y<0 S (DFN,DA)=+Y,DGNEW=$P(Y,"^",3) K DLAYGO "RTN","DG10",13,0) N Y D PAUSE I DGNEW D NEW^DGRP S DA=DFN,VET=$S($D(^DPT(DFN,"VET")):^("VET")'="Y",1:0) "RTN","DG10",14,0) ; "RTN","DG10",15,0) ;MPI QUERY "RTN","DG10",16,0) ;check to see if CIRN PD/MPI is installed "RTN","DG10",17,0) N X S X="MPIFAPI" X ^%ZOSF("TEST") G:'$T SKIP "RTN","DG10",18,0) K MPIFRTN "RTN","DG10",19,0) D MPIQ^MPIFAPI(DFN) "RTN","DG10",20,0) K MPIFRTN "RTN","DG10",21,0) ; "RTN","DG10",22,0) I +$G(DGNEW) D "RTN","DG10",23,0) . ; query CMOR for Patient Record Flag Assignments if NEW patient and "RTN","DG10",24,0) . ; display results "RTN","DG10",25,0) . I $$PRFQRY^DGPFAPI(DFN) D DISPPRF^DGPFAPI(DFN) "RTN","DG10",26,0) ; "RTN","DG10",27,0) SKIP ; "RTN","DG10",28,0) S DGELVER=0 D EN^DGRPD I $D(DGRPOUT) K DGRPOUT G A "RTN","DG10",29,0) D HINQ,REG^IVMCQ($G(DFN)) G A1 "RTN","DG10",30,0) ; "RTN","DG10",31,0) HINQ ; "RTN","DG10",32,0) S Y=$S($D(^DG(43,1,0)):^(0),1:0) I $P(Y,U,27) S X="DVBHQZ4" X ^%ZOSF("TEST") I $T D "RTN","DG10",33,0) .N DGROUT "RTN","DG10",34,0) .S DGROUT=X "RTN","DG10",35,0) .I $G(DFN) D "RTN","DG10",36,0) ..N X,Y,DGRP "RTN","DG10",37,0) ..F X=.3,.32 S DGRP(X)=$G(^DPT(DFN,X)) "RTN","DG10",38,0) ..W !," Money Verified: " S Y=$P(DGRP(.3),"^",6) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NOT VERIFIED") "RTN","DG10",39,0) ..W ?40," Service Verified: " S Y=$P(DGRP(.32),"^",2) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NOT VERIFIED") "RTN","DG10",40,0) .D @("EN^"_DGROUT) K Y Q ;from dgdem0 "RTN","DG10",41,0) Q "RTN","DG10",42,0) ; "RTN","DG10",43,0) ; SDIEMM is used as a flag by AMBCARE Incomplete Encounter Management "RTN","DG10",44,0) ; to bypass the embossing routines when calling load/edit from IEMM "RTN","DG10",45,0) ; "RTN","DG10",46,0) A1 W !,"Do you want to ",$S(DGNEW:"enter",1:"edit")," Patient Data" S %=1 D YN^DICN G H:'%,CK:%'=1 S DGRPV=0 D EN1^DGRP,MT(DFN),CP G Q:$G(DGPRFLG)=1 G Q:$G(SDIEMM) G Q:'$D(DA),EMBOS "RTN","DG10",47,0) ; "RTN","DG10",48,0) H W !?5,"Enter 'YES' to enter/edit registration data or 'NO' to continue without",!?5,"editing." "RTN","DG10",49,0) G A1 "RTN","DG10",50,0) ; "RTN","DG10",51,0) CK S DGEDCN=1 D ^DGRPC,MT(DFN),CP "RTN","DG10",52,0) G Q:$G(DGPRFLG)=1 G Q:$G(SDIEMM) "RTN","DG10",53,0) I $G(DGER)[55 K DIR S DIR(0)="Y",DIR("A")="Do you wish to return to Screen #9 to enter missing Income Data? " D ^DIR K DIR "RTN","DG10",54,0) ;G:Y ^DGRP9 "RTN","DG10",55,0) ; "RTN","DG10",56,0) EMBOS W ! D EMBOS^DGQEMA G A "RTN","DG10",57,0) ; "RTN","DG10",58,0) ; "RTN","DG10",59,0) Q K X,Y,Z,DIC,DGELVER,DGNEW,DGRPV,VET Q "RTN","DG10",60,0) ; "RTN","DG10",61,0) MT(DFN) ; Check if user requires a means test. Ask user if they want to proceedif "RTN","DG10",62,0) ; one is required "RTN","DG10",63,0) I '$D(SDIEMM) DO "RTN","DG10",64,0) .N DGREQF,DIV "RTN","DG10",65,0) .D EN^DGMTR "RTN","DG10",66,0) .I DGREQF D EDT^DGMTU(DFN,DT):$P($$MTS^DGMTU(DFN),U,2)="R" "RTN","DG10",67,0) .Q "RTN","DG10",68,0) I $D(SDIEMM) DO "RTN","DG10",69,0) .N DGMTI "RTN","DG10",70,0) .S DGMTI=$$LST^DGMTU(DFN,SCINF("ENCOUNTER"),1) "RTN","DG10",71,0) .I $P(DGMTI,U,4)="R" D I 1 "RTN","DG10",72,0) ..S DGMT0=$G(^DGMT(408.31,+DGMTI,0)),DGMTDT=$P(DGMT0,"^") "RTN","DG10",73,0) ..I '$$OKTOCONT(DGMTDT) Q "RTN","DG10",74,0) ..S DGMTI=+DGMTI,DGMTYPT=1,DGMTACT="COM",DGMTROU="COM^DGMTEO" D EN^DGMTSC "RTN","DG10",75,0) .E D WARNING "RTN","DG10",76,0) .Q "RTN","DG10",77,0) Q "RTN","DG10",78,0) ; "RTN","DG10",79,0) WARNING ; "RTN","DG10",80,0) ;prints a warning to the screen about means test "RTN","DG10",81,0) ; "RTN","DG10",82,0) W !!,"A means test for this encounter date was not found and may be required!" "RTN","DG10",83,0) W !,"Further investigation will be needed." "RTN","DG10",84,0) W ! "RTN","DG10",85,0) D PAUSE "RTN","DG10",86,0) Q "RTN","DG10",87,0) ; "RTN","DG10",88,0) PAUSE ; "RTN","DG10",89,0) N DIR "RTN","DG10",90,0) S DIR(0)="FAO",DIR("A")="Press ENTER to continue " D ^DIR "RTN","DG10",91,0) Q "RTN","DG10",92,0) ; "RTN","DG10",93,0) OKTOCONT(Y) ; "RTN","DG10",94,0) ; "RTN","DG10",95,0) N DIR "RTN","DG10",96,0) W !!,"Patient Requires a means Test" "RTN","DG10",97,0) X ^DD("DD") "RTN","DG10",98,0) W !,"Primary Means Test Required from '",Y,"'",! "RTN","DG10",99,0) ; "RTN","DG10",100,0) I $D(SDIEMM),'$D(^XUSEC("SCENI MEANS TEST EDIT",DUZ)) DO G OKQ "RTN","DG10",101,0) .W !,$C(7),"You do not have the appropriate IEMM Security Key. Contact your supervisor.",! "RTN","DG10",102,0) .D PAUSE "RTN","DG10",103,0) .S Y=0 "RTN","DG10",104,0) ; "RTN","DG10",105,0) S DIR("A")="Do you wish to proceed with the means test at this time" "RTN","DG10",106,0) S DIR("B")="YES" "RTN","DG10",107,0) S DIR(0)="Y" "RTN","DG10",108,0) D ^DIR "RTN","DG10",109,0) OKQ Q $S(Y=1:1,1:0) "RTN","DG10",110,0) ; "RTN","DG10",111,0) CP ;If not (autoexempt or MTested) & no CP test this year then "RTN","DG10",112,0) ;prompt for add/edit cp test "RTN","DG10",113,0) N DIV,DGIB,DGIBDT,DGX,X,DIRUT,DTOUT "RTN","DG10",114,0) G:'$P($G(^DG(43,1,0)),U,41) QTCP ;USE CP FLAG "RTN","DG10",115,0) S DGIBDT=$S($D(DFN1):9999999-DFN1,1:DT) "RTN","DG10",116,0) D EN^DGMTCOR "RTN","DG10",117,0) I +$G(DGNOCOPF) S DGMTCOR=0 "RTN","DG10",118,0) I DGMTCOR D THRESH^DGMTCOU1(DGIBDT) D EDT^DGMTCOU(DFN,DT) "RTN","DG10",119,0) K DGNOCOPF "RTN","DG10",120,0) QTCP Q "RTN","DG53E574") 0^^B1125154 "RTN","DG53E574",1,0) DG53E574 ; BAY/JAT- Patch DG*5.3*574 Install Utility Routine ; 12/9/03 3:11pm "RTN","DG53E574",2,0) ;;5.3;Registration;**574**;AUG 13, 1993 "RTN","DG53E574",3,0) ; "RTN","DG53E574",4,0) ENV ;Main entry point for Environment check point. "RTN","DG53E574",5,0) ; "RTN","DG53E574",6,0) S XPDABORT="" "RTN","DG53E574",7,0) D PROGCHK(.XPDABORT) ;checks programmer variables "RTN","DG53E574",8,0) I XPDABORT="" K XPDABORT "RTN","DG53E574",9,0) Q "RTN","DG53E574",10,0) ; "RTN","DG53E574",11,0) PROGCHK(XPDABORT) ;checks for necessary programmer variables "RTN","DG53E574",12,0) ; "RTN","DG53E574",13,0) I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D "RTN","DG53E574",14,0) . D BMES^XPDUTL("*****") "RTN","DG53E574",15,0) . D MES^XPDUTL("Your programming variables are not set up properly.") "RTN","DG53E574",16,0) . D MES^XPDUTL("Installation aborted.") "RTN","DG53E574",17,0) . D MES^XPDUTL("*****") "RTN","DG53E574",18,0) . S XPDABORT=2 "RTN","DG53E574",19,0) Q "RTN","DG53P574") 0^^B412426 "RTN","DG53P574",1,0) DG53P574 ; BAY/JAT- Patch DG*5.3*574 Install Utility Routine ; 12/9/03 3:13pm "RTN","DG53P574",2,0) ;;5.3;Registration;**574**;AUG 13, 1993 "RTN","DG53P574",3,0) ; "RTN","DG53P574",4,0) ; "RTN","DG53P574",5,0) ; "RTN","DG53P574",6,0) POST ;Main entry point for Post-install items. "RTN","DG53P574",7,0) ; "RTN","DG53P574",8,0) D POST1 "RTN","DG53P574",9,0) Q "RTN","DG53P574",10,0) POST1 ; Refine Kill logic on "BS" crossreference on Patient file "RTN","DG53P574",11,0) ; NOIS CALL PUG-0999-50739 "RTN","DG53P574",12,0) D MES^XPDUTL("Refining the Kill logic of 'BS' crossreference") "RTN","DG53P574",13,0) S ^DD(2,.09,1,1,2)="K:$E(X,6,9)'="""" ^DPT(""BS"",$E(X,6,9),DA)" "RTN","DG53P574",14,0) Q "RTN","DGPMEVT") 0^3^B3870087 "RTN","DGPMEVT",1,0) DGPMEVT ;ALB/RMO - MAS MOVEMENT EVENT DRIVER; 26 DEC 89 ; 2/2/04 3:18pm "RTN","DGPMEVT",2,0) ;;5.3;Registration;**61,574**;Aug 13, 1993 "RTN","DGPMEVT",3,0) ; "RTN","DGPMEVT",4,0) ;Required Variables: "RTN","DGPMEVT",5,0) ; DFN = Patient's IFN "RTN","DGPMEVT",6,0) ; DGPMDA = Movement's IFN "RTN","DGPMEVT",7,0) ; DGPMP = 0 Node of Primary Movement PRIOR to Add/Edit/Delete "RTN","DGPMEVT",8,0) ; DGPMA = 0 Node of Primary Movement AFTER Add/Edit/Delete "RTN","DGPMEVT",9,0) ; DGQUIET = If $G(DGQUIET) then the read/writes should not "RTN","DGPMEVT",10,0) ; occur (optional) "RTN","DGPMEVT",11,0) ; "RTN","DGPMEVT",12,0) K DTOUT,DIROUT "RTN","DGPMEVT",13,0) ; ************************************************************** "RTN","DGPMEVT",14,0) ;-- establish visit & set pt movement ptr "RTN","DGPMEVT",15,0) I $P($G(^DIC(150.9,1,0)),U,2)["1" D VISIT "RTN","DGPMEVT",16,0) ; ************************************************************** "RTN","DGPMEVT",17,0) N OROLD D INP^VADPT S X=$O(^ORD(101,"B","DGPM MOVEMENT EVENTS",0))_";ORD(101," "RTN","DGPMEVT",18,0) I $P(X,";",1)="" D ERR K VAIN Q "RTN","DGPMEVT",19,0) D EN1^XQOR K VAIN,X "RTN","DGPMEVT",20,0) Q "RTN","DGPMEVT",21,0) ; "RTN","DGPMEVT",22,0) ERR ; "RTN","DGPMEVT",23,0) W !,"Serious error ! DGPM MOVEMENT EVENTS protocol not found" "RTN","DGPMEVT",24,0) W !,"in Protocol file #101. No events fired !" "RTN","DGPMEVT",25,0) W ! "RTN","DGPMEVT",26,0) Q "RTN","DGPMEVT",27,0) ; "RTN","DGPMEVT",28,0) VISIT ;-- create visit file entry for new admissions "RTN","DGPMEVT",29,0) ; "RTN","DGPMEVT",30,0) ;-- Loop through ^UTILITY for admissions, if no prior movement "RTN","DGPMEVT",31,0) ; then new admission. This will capture admissions for ASIH. "RTN","DGPMEVT",32,0) N DGX,DGY "RTN","DGPMEVT",33,0) S DGX="" "RTN","DGPMEVT",34,0) F S DGX=$O(^UTILITY("DGPM",$J,1,DGX)) Q:'DGX D "RTN","DGPMEVT",35,0) . I $G(^UTILITY("DGPM",$J,1,DGX,"A"))]"",$G(^("P"))="" S DGY=^("A") D "RTN","DGPMEVT",36,0) .. S DGY=$$NEW(DGX,DGY) "RTN","DGPMEVT",37,0) .. S ^UTILITY("DGPM",$J,1,DGX,"A")=DGY "RTN","DGPMEVT",38,0) .. S:DGPMDA=DGX DGPMA=DGY "RTN","DGPMEVT",39,0) K VSIT "RTN","DGPMEVT",40,0) Q "RTN","DGPMEVT",41,0) ; "RTN","DGPMEVT",42,0) NEW(DGPM,DGPMA) ; --- add a new entry, new admit "RTN","DGPMEVT",43,0) ; INPUT : DGPM - IEN of admission movement "RTN","DGPMEVT",44,0) ; DGPMA - Oth node of admission movement "RTN","DGPMEVT",45,0) K VSIT "RTN","DGPMEVT",46,0) ; "RTN","DGPMEVT",47,0) ;-- define admission "RTN","DGPMEVT",48,0) ; "RTN","DGPMEVT",49,0) ;--location "RTN","DGPMEVT",50,0) I $D(^DIC(42,+$P(DGPMA,"^",6),44)) S VSIT("LOC")=+^(44) "RTN","DGPMEVT",51,0) I $D(VSIT("LOC")),'$D(^SC(+VSIT("LOC"),0)) K VSIT("LOC") "RTN","DGPMEVT",52,0) ; "RTN","DGPMEVT",53,0) ;--eligibility "RTN","DGPMEVT",54,0) S VSIT("ELG")=$S(+$P(DGPMA,U,20):+$P(DGPMA,U,20),1:+$G(^DPT($P(DGPMA,U,3),.36))) "RTN","DGPMEVT",55,0) G:'VSIT("ELG") NEWQ "RTN","DGPMEVT",56,0) ; "RTN","DGPMEVT",57,0) ;-- get vt ien "RTN","DGPMEVT",58,0) S VSIT=+DGPMA,VSIT(0)="F",VSIT("SVC")="H" "RTN","DGPMEVT",59,0) D ^VSIT "RTN","DGPMEVT",60,0) ; "RTN","DGPMEVT",61,0) ;-- add the vt entry to the admission "RTN","DGPMEVT",62,0) I +$G(VSIT("IEN")) D "RTN","DGPMEVT",63,0) . S DIE="^DGPM(",DA=+DGPM,DR=".27////"_+VSIT("IEN") D ^DIE "RTN","DGPMEVT",64,0) . K DIC,DIE,DA,DR "RTN","DGPMEVT",65,0) . S $P(DGPMA,"^",27)=+VSIT("IEN") "RTN","DGPMEVT",66,0) ; "RTN","DGPMEVT",67,0) NEWQ ; "RTN","DGPMEVT",68,0) K VSIT "RTN","DGPMEVT",69,0) Q DGPMA "RTN","DGPMEVT",70,0) ; "RTN","DGPREP1") 0^2^B35442672 "RTN","DGPREP1",1,0) DGPREP1 ;ALB/SCK - Program to Display Pre-Registration List Cont. 1 ; 12/9/03 3:22pm "RTN","DGPREP1",2,0) ;;5.3;Registration;**109,136,574**;Aug 13, 1993 "RTN","DGPREP1",3,0) Q "RTN","DGPREP1",4,0) EH ; Edit call log information "RTN","DGPREP1",5,0) ; Variables "RTN","DGPREP1",6,0) ; PTIFN - Patients IEN returned form the SELPAT procedure "RTN","DGPREP1",7,0) ; "RTN","DGPREP1",8,0) N PTIFN,D,X,DA,DR "RTN","DGPREP1",9,0) S PTIFN="" "RTN","DGPREP1",10,0) D SELPAT "RTN","DGPREP1",11,0) Q:'$D(PTIFN) "RTN","DGPREP1",12,0) S DIC="^DGS(41.43,",DIC(0)="EQZ" "RTN","DGPREP1",13,0) S X=PTIFN,D="C" "RTN","DGPREP1",14,0) S DIC("A")="Select LOG ENTRY: " "RTN","DGPREP1",15,0) S DIC("S")="I $P(^(0),U,2)=PTIFN" "RTN","DGPREP1",16,0) ; "RTN","DGPREP1",17,0) D IX^DIC K DIC "RTN","DGPREP1",18,0) ; "RTN","DGPREP1",19,0) I Y>0 D "RTN","DGPREP1",20,0) . S DA=+Y "RTN","DGPREP1",21,0) . S DIE="^DGS(41.43," "RTN","DGPREP1",22,0) . S DR="3;2///^S X=$P(^VA(200,DUZ,0),U)" "RTN","DGPREP1",23,0) . D ^DIE K DIE "RTN","DGPREP1",24,0) . I '$D(Y) D "RTN","DGPREP1",25,0) .. S DGPDFN=PTIFN "RTN","DGPREP1",26,0) .. D BLDHIST^DGPREP0 "RTN","DGPREP1",27,0) .. S X=$$SETSTR^VALM1(^TMP("DGPRERG",$J,DGPCH,0),"",1,110) "RTN","DGPREP1",28,0) .. S X=$$SETFLD^VALM1(DGPTAT,X,"HIST") "RTN","DGPREP1",29,0) .. S ^TMP("DGPRERG",$J,DGPCH,0)=X "RTN","DGPREP1",30,0) S VALMBCK="R" "RTN","DGPREP1",31,0) Q "RTN","DGPREP1",32,0) ; "RTN","DGPREP1",33,0) SELPAT ; Select patient if no patient is passed in "RTN","DGPREP1",34,0) N VALMI,VALMAT,VALMY,X "RTN","DGPREP1",35,0) D FULL^VALM1 "RTN","DGPREP1",36,0) D EN^VALM2(XQORNOD(0),"S") S VALMI=0 "RTN","DGPREP1",37,0) I '$D(VALMY) S VALMBCK="R" Q "RTN","DGPREP1",38,0) S DGPN1="",DGPCH=$O(VALMY(DGPN1)) "RTN","DGPREP1",39,0) S PTIFN="",PTIFN=$O(^TMP("DGPRERG",$J,"DFN",DGPCH,PTIFN)) "RTN","DGPREP1",40,0) Q "RTN","DGPREP1",41,0) ; "RTN","DGPREP1",42,0) EDIT ; Edit Patient Information "RTN","DGPREP1",43,0) ; Variables "RTN","DGPREP1",44,0) ; DGPDIV - Division IEN from ^TMP "RTN","DGPREP1",45,0) ; DGPSTMP - Date/Time stamp from UPDLOG function "RTN","DGPREP1",46,0) ; DGPIFN - Patients IEN from ^TMP "RTN","DGPREP1",47,0) ; DGPP1-3,5 - Local Var's for $O "RTN","DGPREP1",48,0) ; DGPNEW - "RTN","DGPREP1",49,0) ; DGPFLG - Flag used to indicate a connect status of 'C' "RTN","DGPREP1",50,0) ; DGPST - Call status returned by SELST function "RTN","DGPREP1",51,0) ; DGPDA - IEN of Call log entry returned from UPDLOG function "RTN","DGPREP1",52,0) ; DGPCH - Entry in the VALMY, selected entries, array "RTN","DGPREP1",53,0) ; "RTN","DGPREP1",54,0) N VALMI,VALMAT,VALMY,X,DGPN5,DGPDIV,DGPSTMP,DGPIFN,DGPP1,DGPP2,DGPP3,DGPNEW,DGPFLG "RTN","DGPREP1",55,0) ; "RTN","DGPREP1",56,0) D FULL^VALM1 "RTN","DGPREP1",57,0) D EN^VALM2(XQORNOD(0),"S") S VALMI=0 "RTN","DGPREP1",58,0) I '$D(VALMY) S VALMBCK="R" Q "RTN","DGPREP1",59,0) S DGPN1="",DGPCH=$O(VALMY(DGPN1)) "RTN","DGPREP1",60,0) S DGPIFN="",DGPIFN=$O(^TMP("DGPRERG",$J,"DFN",DGPCH,DGPIFN)) "RTN","DGPREP1",61,0) S DGPDIV="",DGPDIV=$O(^TMP("DGPRERG",$J,"DIV",DGPCH,DGPDIV)) "RTN","DGPREP1",62,0) S DGNEW=0,DGPFLG=0 "RTN","DGPREP1",63,0) ; "RTN","DGPREP1",64,0) ; *** Check patient sensitivity before proceeding "RTN","DGPREP1",65,0) S DIC=2,DIC(0)="ENQ",X=DGPIFN D ^DIC K DIC "RTN","DGPREP1",66,0) Q:Y<0 "RTN","DGPREP1",67,0) ; "RTN","DGPREP1",68,0) ; *** Check lock status before continuing "RTN","DGPREP1",69,0) S DGPN5="",DGPN5=$O(^DGS(41.42,"B",DGPIFN,DGPN5)) "RTN","DGPREP1",70,0) I DGPN5]"" L +^DGS(41.42,DGPN5):2 I '$T W *7,!,"Another User is Editing this Patient" S VALMBCK="R" Q "RTN","DGPREP1",71,0) ; "RTN","DGPREP1",72,0) S (DA,DFN)=DGPIFN "RTN","DGPREP1",73,0) ; "RTN","DGPREP1",74,0) S DGPFLG=1 "RTN","DGPREP1",75,0) S DGPSTMP="" "RTN","DGPREP1",76,0) D INITLE(.DGPSTMP) "RTN","DGPREP1",77,0) ; "RTN","DGPREP1",78,0) I DGPCH]""&(DGPFLG) D "RTN","DGPREP1",79,0) . S X=$$SETSTR^VALM1(^TMP("DGPRERG",$J,DGPCH,0),"",1,110) "RTN","DGPREP1",80,0) . ;S X=$$SETSTR^VALM1("*",X,8,1) "RTN","DGPREP1",81,0) . I $G(DGPSTMP)]"" S X=$$SETSTR^VALM1($$FMTE^XLFDT(DGPSTMP,"2D"),X,70,8) "RTN","DGPREP1",82,0) . S ^TMP("DGPRERG",$J,DGPCH,0)=X "RTN","DGPREP1",83,0) . S DIE="^DGS(41.42,",DA=DGPN5 "RTN","DGPREP1",84,0) . S DR="4///Y" I DGPSTMP]"" S DR=DR_";3///^S X=DGPSTMP" "RTN","DGPREP1",85,0) . D ^DIE K DIE "RTN","DGPREP1",86,0) L -^DGS(41.42,DGPN5) "RTN","DGPREP1",87,0) K DGPENT,DGPN1,DGPCH,DGPLOC,DGPST,DGPN5,DGPFLG "RTN","DGPREP1",88,0) Q "RTN","DGPREP1",89,0) ; "RTN","DGPREP1",90,0) INITLE(DGPY) ; Initialize for Load/Edit "RTN","DGPREP1",91,0) ; Variables "RTN","DGPREP1",92,0) ; Input: "RTN","DGPREP1",93,0) ; DGPY - Null value "RTN","DGPREP1",94,0) ; "RTN","DGPREP1",95,0) ; Returns: "RTN","DGPREP1",96,0) ; DGPY - Returns the date/time stamp entered into ^DGS(41.41,. "RTN","DGPREP1",97,0) ; "RTN","DGPREP1",98,0) ; Local: "RTN","DGPREP1",99,0) ; DGPRFLG - This flag is used by the Patient Load/Edit routines "RTN","DGPREP1",100,0) ; to indicate they were called by preregistration "RTN","DGPREP1",101,0) ; DGPLOC - Flag used by DG10 to indicate preselection of a patient "RTN","DGPREP1",102,0) ; "RTN","DGPREP1",103,0) N DGPRFLG "RTN","DGPREP1",104,0) S (DGPRFLG,DGPLOC)=1 "RTN","DGPREP1",105,0) W !! "RTN","DGPREP1",106,0) D ^DG10 "RTN","DGPREP1",107,0) Q:$G(DGPFLG)&($G(DGRPOUT)) "RTN","DGPREP1",108,0) ; "RTN","DGPREP1",109,0) S DGPST=$$SELST "RTN","DGPREP1",110,0) I DGPST']"" S VALMBCK="R" Q "RTN","DGPREP1",111,0) ; "RTN","DGPREP1",112,0) I DGPST'="L" D "RTN","DGPREP1",113,0) . S DGPDA=$$UPDLOG(DGPIFN,DGPST,DGPDIV) Q:DGPDA'>0 "RTN","DGPREP1",114,0) . I '$G(DGMODE),$P($G(^DGS(41.43,DGPDA,0)),U,4)]"" D "RTN","DGPREP1",115,0) .. S X=$$SETSTR^VALM1(^TMP("DGPRERG",$J,DGPCH,0),"",1,110) "RTN","DGPREP1",116,0) .. S DGPP1=$E(X,1,34),DGPP2=$E(X,35,38),DGPP3=$E(X,39,110) "RTN","DGPREP1",117,0) .. S DGPP2=$P(^DGS(41.43,DGPDA,0),U,4)_DGPP2 "RTN","DGPREP1",118,0) .. S X=DGPP1_$E(DGPP2,1,4)_DGPP3 "RTN","DGPREP1",119,0) .. S ^TMP("DGPRERG",$J,DGPCH,0)=X "RTN","DGPREP1",120,0) ; "RTN","DGPREP1",121,0) W ! "RTN","DGPREP1",122,0) S DIR(0)="YA",DIR("A")="Date/Time stamp this patient? ",DIR("B")="YES" "RTN","DGPREP1",123,0) D ^DIR K DIR "RTN","DGPREP1",124,0) W ! "RTN","DGPREP1",125,0) I Y D "RTN","DGPREP1",126,0) . K DD,DO "RTN","DGPREP1",127,0) . S DGPY=$$NOW^XLFDT "RTN","DGPREP1",128,0) . S DIC="^DGS(41.41,",DIC(0)="EQZ",X=DFN "RTN","DGPREP1",129,0) . S DIC("DR")="1///^S X=DGPY;2////^S X=DUZ" "RTN","DGPREP1",130,0) . D FILE^DICN "RTN","DGPREP1",131,0) . K DIC "RTN","DGPREP1",132,0) ; "RTN","DGPREP1",133,0) Q "RTN","DGPREP1",134,0) STAT ; Display call history "RTN","DGPREP1",135,0) K PTIFN D SELPAT "RTN","DGPREP1",136,0) I $D(PTIFN) D "RTN","DGPREP1",137,0) . D EN^DGPREP2 "RTN","DGPREP1",138,0) K PTIFN "RTN","DGPREP1",139,0) Q "RTN","DGPREP1",140,0) ; "RTN","DGPREP1",141,0) SELST() ; Function to select status for call log "RTN","DGPREP1",142,0) ; Returns: "RTN","DGPREP1",143,0) ; Status code as a SOC "RTN","DGPREP1",144,0) ; "RTN","DGPREP1",145,0) K DIRUT "RTN","DGPREP1",146,0) N DIR "RTN","DGPREP1",147,0) W !! "RTN","DGPREP1",148,0) S DIR(0)="41.43,3" "RTN","DGPREP1",149,0) S DIR("A")="STATUS OF CALL",DIR("B")="CONNECTED" "RTN","DGPREP1",150,0) S DIR("?",1)="Enter the status of the current call from the list below." "RTN","DGPREP1",151,0) S DIR("?")="Entries must be in uppercase, and match on of these codes." "RTN","DGPREP1",152,0) D ^DIR K DIR "RTN","DGPREP1",153,0) Q $G(Y) "RTN","DGPREP1",154,0) ; "RTN","DGPREP1",155,0) UPDLOG(DFN,DGPS,DGPDV) ; Update PRE-REGISTRATION CALL LOG File, #41.43 "RTN","DGPREP1",156,0) ; "RTN","DGPREP1",157,0) ; Variables "RTN","DGPREP1",158,0) ; Input: "RTN","DGPREP1",159,0) ; DFN - The IEN of the patient being called "RTN","DGPREP1",160,0) ; DGPS - Status of the call attempt "RTN","DGPREP1",161,0) ; DGPDV - Division IEN (used for sorting) "RTN","DGPREP1",162,0) ; "RTN","DGPREP1",163,0) ; Returns: "RTN","DGPREP1",164,0) ; The IEN of the CALL LOG, File #41.43, entry that was added. "RTN","DGPREP1",165,0) ; 0 is returned if the user ^'s out. "RTN","DGPREP1",166,0) ; "RTN","DGPREP1",167,0) K DD,DO "RTN","DGPREP1",168,0) S DIC="^DGS(41.43," "RTN","DGPREP1",169,0) S DIC(0)="L" "RTN","DGPREP1",170,0) S X=$$NOW^XLFDT "RTN","DGPREP1",171,0) D FILE^DICN "RTN","DGPREP1",172,0) I Y<0 W *7,"Problem adding to file - PRE-REGISTRATION CALL LOG" "RTN","DGPREP1",173,0) I Y'<0 D "RTN","DGPREP1",174,0) . S DIE="^DGS(41.43," "RTN","DGPREP1",175,0) . S DR="1////^S X=DFN;2////^S X=DUZ;3///^S X=DGPS;5////^S X=$S(+DGPDV>0:DGPDV,1:"""")" "RTN","DGPREP1",176,0) . S DA=+Y "RTN","DGPREP1",177,0) . D ^DIE K DIE "RTN","DGPREP1",178,0) . I $D(Y) D "RTN","DGPREP1",179,0) .. S DIK="^DGS(41.43," D ^DIK K DIK "RTN","DGPREP1",180,0) Q +$G(DA) "RTN","DGPREP1",181,0) ; "RTN","DGPREP1",182,0) DIREDT ; Direct edit of a patient in the PRE-REGISTRATION CALL LIST, bypassing the call list. "RTN","DGPREP1",183,0) ; "RTN","DGPREP1",184,0) ; Variables "RTN","DGPREP1",185,0) ; DFN - Patients IEN, set for Load/Edit "RTN","DGPREP1",186,0) ; DGPDIV - Division IEN from File #41.42 "RTN","DGPREP1",187,0) ; DGPST - Call Status "RTN","DGPREP1",188,0) ; DGPIDX - Call List IEN, File #41.42 "RTN","DGPREP1",189,0) ; DGPFLG - Flag for direct patient edit, used for setting 'called' status "RTN","DGPREP1",190,0) ; DGPSTMP - Date/time stamp "RTN","DGPREP1",191,0) ; "RTN","DGPREP1",192,0) N DFN,DGPDIV,DGPST,DGPIDX,DGPFLG,DGNEW,DGPXX,DGPSTMP,DGPX,DGPIFN,DGMODE "RTN","DGPREP1",193,0) N DGRPOUT "RTN","DGPREP1",194,0) ; "RTN","DGPREP1",195,0) K DTOUT,DUOUT,DIC "RTN","DGPREP1",196,0) S DIC=2,DIC(0)="AEQZM" "RTN","DGPREP1",197,0) S DIC("A")="Select Patient to Preregister: " "RTN","DGPREP1",198,0) S DIC("?")="Select a patient whose preregistration information you want to edit." "RTN","DGPREP1",199,0) D ^DIC K DIC "RTN","DGPREP1",200,0) I $D(DTOUT)!($D(DUOUT))!(Y<0) Q "RTN","DGPREP1",201,0) ; "RTN","DGPREP1",202,0) S (DFN,DGPIFN)=+Y,DGPIDX="" "RTN","DGPREP1",203,0) I $D(^DGS(41.42,"B",DFN)) D Q:$G(DGPX) "RTN","DGPREP1",204,0) . S DGPIDX=$O(^DGS(41.42,"B",DFN,DGPIDX)) "RTN","DGPREP1",205,0) . S DGPDIV=$P($G(^DGS(41.42,DGPIDX,0)),U,2) "RTN","DGPREP1",206,0) . I DGPIDX]"" L +^DGS(41.42,DGPIDX):2 I '$T W *7,!,"Another user is editing this patient." S DGPX=1 "RTN","DGPREP1",207,0) ; "RTN","DGPREP1",208,0) S DGNEW=0,DGPFLG=1,DGPSTMP="",DGMODE=1 "RTN","DGPREP1",209,0) ; "RTN","DGPREP1",210,0) ; ** Since this is a direct call for a patient, and the particular appt. is not known, set DGPDIV to primary medical center division. "RTN","DGPREP1",211,0) I $G(DGPDIV)']"" D "RTN","DGPREP1",212,0) . S DGPDIV=$$PRIM^VASITE "RTN","DGPREP1",213,0) ; "RTN","DGPREP1",214,0) D INITLE(.DGPSTMP) "RTN","DGPREP1",215,0) ; "RTN","DGPREP1",216,0) I $G(DGRPOUT) G UNLCK "RTN","DGPREP1",217,0) ; "RTN","DGPREP1",218,0) I $G(DGPFLG),DGPIDX]"" D "RTN","DGPREP1",219,0) . S DA=DGPIDX "RTN","DGPREP1",220,0) . S DIE="^DGS(41.42," "RTN","DGPREP1",221,0) . S DR="4///Y" I DGPSTMP]"" S DR=DR_";3///^S X=DGPSTMP" "RTN","DGPREP1",222,0) . D ^DIE K DIE "RTN","DGPREP1",223,0) ; "RTN","DGPREP1",224,0) UNLCK I $G(DGPIDX)]"" L -^DGS(41.42,DGPIDX) "RTN","DGPREP1",225,0) Q "RTN","DGREG") 0^4^B47358258 "RTN","DGREG",1,0) DGREG ;ALB/JDS,MRL-REGISTER PATIENT ; 1/15/04 7:28pm "RTN","DGREG",2,0) ;;5.3;Registration;**1,32,108,147,149,182,245,250,513,425,533,574**;Aug 13, 1993 "RTN","DGREG",3,0) START ; "RTN","DGREG",4,0) EN D LO^DGUTL S DGCLPR="" "RTN","DGREG",5,0) N DGDIV "RTN","DGREG",6,0) S DGDIV=$$PRIM^VASITE "RTN","DGREG",7,0) S:DGDIV %ZIS("B")=$P($G(^DG(40.8,+DGDIV,"DEV")),U,1) "RTN","DGREG",8,0) I $P(^DG(43,1,0),U,39) S %ZIS="NQ",%ZIS("A")="Select 1010 printer: " D ^%ZIS Q:POP S (DGIO(10),DGIO("PRF"),DGIO("RT"),DGIO("HS"))=ION,DGASKDEV="" I $E(IOST,1,2)'["P-" W !,$C(7),"Not a printer" G DGREG "RTN","DGREG",9,0) K %ZIS("B") "RTN","DGREG",10,0) I '$D(DGIO),$P(^DG(43,1,0),U,30) S %ZIS="N",IOP="HOME" D ^%ZIS I $D(IOS),IOS,$D(^%ZIS(1,+IOS,99)),$D(^%ZIS(1,+^(99),0)) S Y=$P(^(0),U,1) W !,"Using closest printer ",Y,! F I=10,"PRF","RT","HS" S DGIO(I)=Y "RTN","DGREG",11,0) A D ENDREG($G(DFN)) I '$G(DG1010TF) W !! S DIC=2,DIC(0)="ALEQM",DLAYGO=2 K DIC("S"),DIC("B") D ^DIC K DLAYGO G Q1:Y<0 S (DFN,DA)=+Y,DGNEW=$P(Y,"^",3) N Y D PAUSE^DG10 D BEGINREG(DFN) I DGNEW D NEW^DGRP "RTN","DGREG",12,0) ; "RTN","DGREG",13,0) D CIRN "RTN","DGREG",14,0) ; "RTN","DGREG",15,0) I +$G(DGNEW) D "RTN","DGREG",16,0) . ; query CMOR for Patient Record Flag Assignments if NEW patient and "RTN","DGREG",17,0) . ; display results. "RTN","DGREG",18,0) . I $$PRFQRY^DGPFAPI(DFN) D DISPPRF^DGPFAPI(DFN) "RTN","DGREG",19,0) ; "RTN","DGREG",20,0) D ROMQRY "RTN","DGREG",21,0) ; "RTN","DGREG",22,0) S (DGFC,CURR)=0 "RTN","DGREG",23,0) D:'$G(DGNEW) WARN S DA=DFN,DGFC="^1",VET=$S($D(^DPT(DFN,"VET")):^("VET")'="Y",1:0) "RTN","DGREG",24,0) I '$G(DG1010TF) S %ZIS="N",IOP="HOME" D ^%ZIS S DGELVER=0 D EN^DGRPD I $D(DGRPOUT) D ENDREG($G(DFN)) D HL7A08^VAFCDD01 K DFN,DGRPOUT G A "RTN","DGREG",25,0) I '$G(DG1010TF) D HINQ^DG10 "RTN","DGREG",26,0) I $D(^DIC(195.4,1,"UP")) I ^("UP") D ADM^RTQ3 "RTN","DGREG",27,0) D REG^IVMCQ($G(DFN)) ; send financial query "RTN","DGREG",28,0) G A1 "RTN","DGREG",29,0) ; "RTN","DGREG",30,0) RT I $D(^DIC(195.4,1,"UP")) I ^("UP") S $P(DGFC,U,1)=DIV D ADM^RTQ3 "RTN","DGREG",31,0) Q "RTN","DGREG",32,0) ; "RTN","DGREG",33,0) A1 I '$G(DG1010TF) W !,"Do you want to ",$S(DGNEW:"enter",1:"edit")," Patient Data" S %=1 D YN^DICN G H:'%,CK:%'=1 S DGRPV=0 D EN1^DGRP G Q:'$D(DA) "RTN","DGREG",34,0) G CH "RTN","DGREG",35,0) PR W !!,"Is the patient currently being followed in a clinic for the same condition" S %=0 D YN^DICN G Q:%=-1 "RTN","DGREG",36,0) I '% W !?4,$C(7),"Enter 'Y' if the patient is being followed in clinic for condition for which",!?6,"registered, 'N' if not." G PR "RTN","DGREG",37,0) S CURR=% G SEEN "RTN","DGREG",38,0) ; "RTN","DGREG",39,0) CK S DGEDCN=1 D ^DGRPC "RTN","DGREG",40,0) CH S X=$S('$D(^DPT(DFN,.36)):1,$P(^(.36),"^",1)']"":1,1:0),X1=$S('$D(^DPT(DFN,.32)):1,$P(^(.32),"^",3)']"":1,1:0) I 'X,'X1 G CH1 "RTN","DGREG",41,0) CH1 S DA=DFN G PR:'$D(^DPT("ADA",1,DA)) W !!,"There is still an open disposition--register aborted.",$C(7),$C(7) G Q "RTN","DGREG",42,0) SEEN W !!,"Is the patient to be examined in the medical center today" S %=1 D YN^DICN S SEEN=% G:%<0 Q I %'>0 W !!,"Enter 'Y' if the patient is to be examined today, 'N' if not.",$C(7) G SEEN "RTN","DGREG",43,0) ABIL D ^DGREGG "RTN","DGREG",44,0) ENR ; next line appears to be dead code. left commented just to test. mli 4/28/94 "RTN","DGREG",45,0) ;S DE=0 F I=0:0 S I=$O(^DPT(DA,"DE",I)) Q:'I I $P(^(I,0),"^",3)'?7N Q D PR:'DE S L=+$P($S($D(^SC(L,0)):^(0),1:""),"^",1) "RTN","DGREG",46,0) REG S (DIE,DIC)="^DPT("_DFN_",""DIS"",",%DT="PTEX",%DT("A")="Registration login date/time: NOW// " "RTN","DGREG",47,0) W !,%DT("A") R ANS:DTIME S:'$T ANS="^" S:ANS="" ANS="N" S X=ANS G Q:ANS="^" S DA(1)=DFN D CHK^DIE(2.101,.01,"E",X,.RESULT) G REG:RESULT="^"!('$D(RESULT)),PR3:'(RESULT#1) S Y=RESULT "RTN","DGREG",48,0) I (RESULT'="^") W " ("_RESULT(0)_")" "RTN","DGREG",49,0) S DINUM=9999999-RESULT "RTN","DGREG",50,0) S (DFN1,Y1)=DINUM,APD=Y I $D(^DPT(DFN,"DIS",Y1)) W !!,"You must enter a date that does not exist.",$C(7),$C(7) G REG "RTN","DGREG",51,0) G:$D(^DPT("ADA",1,DA)) CH1 L @(DIE_DINUM_")"):2 G:'$T MSG S:'($D(^DPT(DA(1),"DIS",0))#2) ^(0)="^2.101D^^" S DIC(0)="L",X=+Y D ^DIC "RTN","DGREG",52,0) ; "RTN","DGREG",53,0) ;SAVE OFF DATE/TIME OF REGISTRATION FOR HL7 V2.3 MESSAGING, IN VAFCDDT "RTN","DGREG",54,0) S VAFCDDT=X "RTN","DGREG",55,0) ; "RTN","DGREG",56,0) S DA=DFN1,DIE("NO^")="",DA(1)=DFN,DP=2.101,DR="1///"_$S(SEEN=2:2,CURR=1:1,1:0)_";Q;2"_$S(CURR=1:"///3",1:"")_";2.1;3//"_$S($P(^DG(43,1,"GL"),"^",2):"",1:"/")_$S($D(^DG(40.8,+$P(^DG(43,1,"GL"),"^",3),0)):$P(^(0),"^",1),1:"")_";4////"_DUZ "RTN","DGREG",57,0) I $G(DG1010TF) S DR=DR_";.2///1" "RTN","DGREG",58,0) D EL K DIC("A") N DGNDLOCK S DGNDLOCK=DIE_DFN1_")" L +@DGNDLOCK:2 G:'$T MSG D ^DIE L -@DGNDLOCK "RTN","DGREG",59,0) I $D(DTOUT) D G Q "RTN","DGREG",60,0) .K DTOUT "RTN","DGREG",61,0) .N DA,DIK "RTN","DGREG",62,0) .S DA(1)=DFN,DA=DFN1,DIK="^DPT("_DFN_",""DIS""," "RTN","DGREG",63,0) .D ^DIK "RTN","DGREG",64,0) .W !!?5,"User Time-out. Required registration data could be missing." "RTN","DGREG",65,0) .W !,?5,"This registration has been deleted." "RTN","DGREG",66,0) ; check whether facility applying to (division) is inactive "RTN","DGREG",67,0) I '$$DIVCHK^DGREGFAC(DFN,DFN1) G CONT "RTN","DGREG",68,0) ASKDIV W !!?5,"The facility chosen either has no pointer to an Institution" "RTN","DGREG",69,0) W !?5,"file record or the Institution file record is inactive." "RTN","DGREG",70,0) W !?5,"Please choose another division." "RTN","DGREG",71,0) S DA=DFN1,DIE("NO^")="",DA(1)=DFN,DP=2.101,DR="3" D ^DIE "RTN","DGREG",72,0) I $$DIVCHK^DGREGFAC(DFN,DFN1) G ASKDIV "RTN","DGREG",73,0) CONT ; continue "RTN","DGREG",74,0) S DGXXXD=1 D EL^DGREGE I $P(^DPT(DFN,"DIS",DFN1,0),"^",3)=4 S DA=DFN,DIE="^DPT(",DR=".368;.369" D ^DIE S DIE="^DPT("_DFN_",""DIS"",",DA(1)=DFN,DA=DFN1 "RTN","DGREG",75,0) S DA=DFN,DR="[DGREG]",DIE="^DPT(" D ^DIE K DIE("NO^") "RTN","DGREG",76,0) I $D(^DPT(DFN,"DIS",DFN1,2)),$P(^(2),"^",1)="Y" S DIE="^DPT(",DR="[DG EMPLOYER]",DA=DFN D ^DIE "RTN","DGREG",77,0) G ^DGREG0 "RTN","DGREG",78,0) PR2 W !!,"You can only enter new registrations through this option.",$C(7),$C(7) G REG "RTN","DGREG",79,0) PR3 W !!,"Time is required to register the patient.",!!,$C(7),$C(7) G REG "RTN","DGREG",80,0) H W !?5,"Enter 'YES' to enter/edit registration data or 'NO' to continue." G A1 "RTN","DGREG",81,0) Q K DG,DQ G Q1^DGREG0 "RTN","DGREG",82,0) Q1 K DGIO,DGASKDEV,DGFC,DGCLRP,CURR,DGELVER,DGNEW Q "RTN","DGREG",83,0) EL S DR=DR_";13//" I $D(^DPT(DFN,.36)),$D(^DIC(8,+^(.36),0)) S DR=DR_$P(^(0),"^",1) Q "RTN","DGREG",84,0) S DR=DR_"HUMANITARIAN EMERGENCY" Q "RTN","DGREG",85,0) FEE S DGRPFEE=1 D DGREG K DGRPFEE G Q1 "RTN","DGREG",86,0) ; "RTN","DGREG",87,0) EN1010T(DFN,DGNEWPF,DGDIV,DGIO,DGASKDEV,DG1010TF) ;Registration entry point for 10-10T "RTN","DGREG",88,0) S DGNEW=DGNEWPF ;set new patient flag "RTN","DGREG",89,0) I $G(DGASKDF) S DGASKDEV="" ;ask device flag "RTN","DGREG",90,0) D A "RTN","DGREG",91,0) K DFN1,DG1,DGMT,DGMTCOR,DGRGAUTO,DGWRT "RTN","DGREG",92,0) G Q1 "RTN","DGREG",93,0) ; "RTN","DGREG",94,0) WARN I $S('$D(^DPT(DFN,.1)):0,$P(^(.1),"^",1)']"":0,1:1) W !,$C(7),"***PATIENT IS CURRENTLY AN INPATIENT***",! H 2 "RTN","DGREG",95,0) I $S('$D(^DPT(DFN,.107)):0,$P(^(.107),"^",1)']"":0,1:1) W !,$C(7),"***PATIENT IS CURRENTLY A LODGER***",! H 2 "RTN","DGREG",96,0) Q "RTN","DGREG",97,0) MSG W !,"Another user is editing, try later ..." G Q "RTN","DGREG",98,0) ; "RTN","DGREG",99,0) BEGINREG(DFN) ; "RTN","DGREG",100,0) ;Description: This is called at the begining of the registration process. "RTN","DGREG",101,0) ;Concurrent processes can check the lock to determine if the patient is "RTN","DGREG",102,0) ;currently being registered. "RTN","DGREG",103,0) ; "RTN","DGREG",104,0) Q:'$G(DFN) 0 "RTN","DGREG",105,0) I $$QRY^DGENQRY(DFN) W !!,"Enrollment/Eligibility Query sent ...",!! "RTN","DGREG",106,0) L +^TMP(DFN,"REGISTRATION IN PROGRESS"):1 "RTN","DGREG",107,0) I $$LOCK^DGENPTA1(DFN) ;try to lock the patient record "RTN","DGREG",108,0) Q "RTN","DGREG",109,0) ; "RTN","DGREG",110,0) ENDREG(DFN) ; "RTN","DGREG",111,0) ;Description: releases the lock obtained by calling BEGINREG. "RTN","DGREG",112,0) ; "RTN","DGREG",113,0) Q:'$G(DFN) "RTN","DGREG",114,0) L -^TMP(DFN,"REGISTRATION IN PROGRESS") "RTN","DGREG",115,0) D UNLOCK^DGENPTA1(DFN) "RTN","DGREG",116,0) Q "RTN","DGREG",117,0) ; "RTN","DGREG",118,0) IFREG(DFN) ; "RTN","DGREG",119,0) ;Description: tests whether the lock set by BEGINREG is set "RTN","DGREG",120,0) ; "RTN","DGREG",121,0) ;Input: DFN "RTN","DGREG",122,0) ;Output: "RTN","DGREG",123,0) ; Function Value = 1 if lock is set, 0 otherwise "RTN","DGREG",124,0) ; "RTN","DGREG",125,0) N RETURN "RTN","DGREG",126,0) Q:'$G(DFN) 0 "RTN","DGREG",127,0) L +^TMP(DFN,"REGISTRATION IN PROGRESS"):1 "RTN","DGREG",128,0) S RETURN='$T "RTN","DGREG",129,0) L -^TMP(DFN,"REGISTRATION IN PROGRESS") "RTN","DGREG",130,0) Q RETURN "RTN","DGREG",131,0) Q "RTN","DGREG",132,0) CIRN ;MPI QUERY "RTN","DGREG",133,0) ;check to see if CIRN PD/MPI is installed "RTN","DGREG",134,0) N X S X="MPIFAPI" X ^%ZOSF("TEST") Q:'$T "RTN","DGREG",135,0) K MPIFRTN "RTN","DGREG",136,0) D MPIQ^MPIFAPI(DFN) "RTN","DGREG",137,0) K MPIFRTN "RTN","DGREG",138,0) Q "RTN","DGREG",139,0) ROMQRY ; "RTN","DGREG",140,0) I +$G(DGNEW) D "RTN","DGREG",141,0) . ; query LST for Patient Demographic Information if NEW patient and "RTN","DGREG",142,0) . ; file into patient's record. "RTN","DGREG",143,0) . N A "RTN","DGREG",144,0) . I $$ROMQRY^DGROAPI(DFN) D "RTN","DGREG",145,0) . . ;display busy message to interactive users "RTN","DGREG",146,0) . .S DGMSG(1)="Data retrieval from LST site has been completed successfully" "RTN","DGREG",147,0) . .S DGMSG(2)="Thank you for your patience." "RTN","DGREG",148,0) . .D EN^DDIOL(.DGMSG) R A:5 "RTN","DGREG",149,0) . E D "RTN","DGREG",150,0) . . ;display busy message to interactive users "RTN","DGREG",151,0) . .S DGMSG(1)="Data retrieval from LST site has not been successful." "RTN","DGREG",152,0) . .S DGMSG(2)="Please continue the Registration Process." "RTN","DGREG",153,0) . .D EN^DDIOL(.DGMSG) R A:5 "RTN","DGREG",154,0) . ; "RTN","DGREG",155,0) Q "RTN","DGREGFAC") 0^5^B466833 "RTN","DGREGFAC",1,0) DGREGFAC ;BAY/JT; 12/18/03 8:16am ; 12/18/03 9:55am "RTN","DGREGFAC",2,0) ;;5.3;Registration;**574**;Aug 13, 1993 "RTN","DGREGFAC",3,0) DIVCHK(DFN,DFN1) ; call to validate 'facility applying to' (division) "RTN","DGREGFAC",4,0) ; DFN = ien of patient file "RTN","DGREGFAC",5,0) ; DFN1 = ien of Disposition multiple "RTN","DGREGFAC",6,0) ; returns 1 if division is inactive, 0 otherwise "RTN","DGREGFAC",7,0) ; "RTN","DGREGFAC",8,0) N DGDIV,DGINST "RTN","DGREGFAC",9,0) I '$G(DFN)!('$G(DFN1)) Q 0 "RTN","DGREGFAC",10,0) ; site not multi-divisional "RTN","DGREGFAC",11,0) I $P($G(^DG(43,1,"GL")),U,2)=0 Q 0 "RTN","DGREGFAC",12,0) ; determine division chosen "RTN","DGREGFAC",13,0) S DGDIV=$P($G(^DPT(DFN,"DIS",DFN1,0)),U,4) "RTN","DGREGFAC",14,0) I DGDIV'>0 Q 0 "RTN","DGREGFAC",15,0) ; division has no pointer to Institution file "RTN","DGREGFAC",16,0) I $P($G(^DG(40.8,DGDIV,0)),U,7)'>0 Q 1 "RTN","DGREGFAC",17,0) S DGINST=$P($G(^DG(40.8,DGDIV,0)),U,7) "RTN","DGREGFAC",18,0) ; Institution file is inactive "RTN","DGREGFAC",19,0) I $P($G(^DIC(4,DGINST,99)),U,4)=1 Q 1 "RTN","DGREGFAC",20,0) Q 0 "RTN","DPTLK1") 0^6^B33727794 "RTN","DPTLK1",1,0) DPTLK1 ;ALB/RMO - MAS Patient Look-up Check Cross-References ; 1/14/04 7:25pm "RTN","DPTLK1",2,0) ;;5.3;Registration;**32,50,197,249,317,391,244,532,574**;Aug 13, 1993 "RTN","DPTLK1",3,0) FIND ;Cross reference patient lookup "RTN","DPTLK1",4,0) ;Optional input: DPTNOFZY='1' to suppress fuzzy lookups implemented "RTN","DPTLK1",5,0) ; by patch DG*5.3*244 "RTN","DPTLK1",6,0) ; "RTN","DPTLK1",7,0) N DDCOMA,DPTXOLD,DPTOUT,DPTOVAL "RTN","DPTLK1",8,0) S (DPTXOLD,DPTX)=$$UCASE(DPTX) "RTN","DPTLK1",9,0) I DPTX?1A.E1","1.A.E S DPTXOLD=DPTX,DDCOMA="I $E($P($G(DPTVAL),"","",2),1,"_$L($P(DPTX,",",2))_")="""_$TR($P(DPTX,",",2),"""")_"""",DPTX=$P(DPTX,",") "RTN","DPTLK1",10,0) K DPTREFS S DPTREFS=$S(DIC(0)'["M":"B,NOP",DPTX?1A1N.N:$S($L(DPTX)<6:"BS5,CN,RM",1:"CN,RM"),DPTX?4N!(DPTX?4N1A):"BS,SSN,CN,RM",DPTX?9N.E:"SSN,CN,RM",1:"") "RTN","DPTLK1",11,0) S:DPTREFS="" DPTREFS=$S(DPTX?1N.N:$S($L(DPTX)<5:"CN,RM,BS,SSN",1:"CN,RM,SSN"),DPTX?1N.E:"CN,RM",1:"B,NOP,CN,RM") S:$D(DPTIX) DPTREFS=DPTIX_","_DPTREFS "RTN","DPTLK1",12,0) S DPTBEG=1,(DPTDFN,DPTNUM,DPTOUT)=0 "RTN","DPTLK1",13,0) F DPTLP=1:1 S DPTREF=$P(DPTREFS,",",DPTLP) Q:DPTREF=""!(DPTDFN) D Q:DPTDFN!DPTOUT "RTN","DPTLK1",14,0) .S DPTVAL=DPTX "RTN","DPTLK1",15,0) .I DPTREF="NOP",'$G(DPTNOFZY) S DPTVAL=$$FORMAT^DPTNAME(DPTVAL,2,30,1,0,,1) Q:'$L(DPTVAL) "RTN","DPTLK1",16,0) .D LOOK(DPTVAL) "RTN","DPTLK1",17,0) .I DPTREF="B",'$G(DPTNOFZY) S DPTVAL=$$FORMAT^DPTNAME(DPTX,2,30,1,0,,1) D:DPTVAL'=DPTX LOOK(DPTVAL) "RTN","DPTLK1",18,0) .Q "RTN","DPTLK1",19,0) I 'DPTDFN S:DPTCNT=1&($D(DPTIFNS(DPTCNT))) DPTDFN=+DPTIFNS(DPTCNT) S DPT("NOPRT^")="" D PRTDPT:'DPTDFN&(DPTCNT>DPTNUM)&(DIC(0)["E") K DPT("NOPRT^") I 'DPTDFN,$D(DPTSEL),DPTSEL="" S DPTX="",DPTDFN=-1 "RTN","DPTLK1",20,0) I DPTDFN'>0,$L($G(DPTXOLD)) I DPTX=$P(DPTXOLD,",") S DPTX=DPTXOLD "RTN","DPTLK1",21,0) I DPTDFN>0,$D(DPTXOLD) S DPTX=DPTXOLD "RTN","DPTLK1",22,0) ; "RTN","DPTLK1",23,0) Q K DPTBEG,DPTIFN,DPTIFNS,DPTLP,DPTLP1,DPTNUM,DPTREF,DPTREFS,DPTVAL "RTN","DPTLK1",24,0) K DPTOVAL,DPTOUT,DPTXOLD,^TMP("DPTLK",$J) "RTN","DPTLK1",25,0) Q "RTN","DPTLK1",26,0) ; "RTN","DPTLK1",27,0) LOOK(DPTVAL) ;Look for x-ref matches "RTN","DPTLK1",28,0) ;Input: DPTVAL=lookup seed value "RTN","DPTLK1",29,0) I $L(DPTVAL),$D(^DPT(DPTREF,DPTVAL)) D CHKIFN Q:DPTDFN!DPTOUT "RTN","DPTLK1",30,0) I $L(DPTVAL),'($D(^DPT(DPTREF,DPTVAL))&(DIC(0)["O"))&(DIC(0)'["X") D CHKVAL "RTN","DPTLK1",31,0) Q "RTN","DPTLK1",32,0) ; "RTN","DPTLK1",33,0) CHKVAL S DPTOVAL=DPTVAL "RTN","DPTLK1",34,0) N DPTSEED S DPTSEED=DPTVAL "RTN","DPTLK1",35,0) I DPTREF="SSN",(DPTVAL?9N1"p") D Q "RTN","DPTLK1",36,0) .S DPTVAL=$E(DPTVAL,1,9)_"P" D CHKIFN "RTN","DPTLK1",37,0) .Q "RTN","DPTLK1",38,0) I DPTREF="SSN",(DPTVAL?2.9N) D Q "RTN","DPTLK1",39,0) .S DPTVAL=$E(DPTVAL_"0000000",1,9) "RTN","DPTLK1",40,0) .D CV1(DPTVAL),CHKIFN "RTN","DPTLK1",41,0) .S DPTVAL=DPTVAL_"P" D CV1(DPTVAL),CHKIFN "RTN","DPTLK1",42,0) .Q "RTN","DPTLK1",43,0) D CV1(DPTVAL) "RTN","DPTLK1",44,0) I DPTREF="CN"!(DPTREF="RM"),DPTVAL'["E",DPTVAL=+DPTVAL,'$D(^DPT(DPTREF,DPTVAL)) D Q "RTN","DPTLK1",45,0) .S DPTVAL=$O(^DPT(DPTREF,DPTVAL_" "),-1) "RTN","DPTLK1",46,0) .D CV1(DPTVAL) "RTN","DPTLK1",47,0) .Q "RTN","DPTLK1",48,0) Q "RTN","DPTLK1",49,0) ; "RTN","DPTLK1",50,0) CV1(DPTVAL) ;Look for input value matches "RTN","DPTLK1",51,0) I $L(DPTVAL) F DPTLP1=0:0 S DPTVAL=$O(^DPT(DPTREF,DPTVAL)) Q:DPTVAL=""!(DPTDFN)!($P(DPTVAL,DPTSEED)'="") D CHKIFN "RTN","DPTLK1",52,0) Q "RTN","DPTLK1",53,0) ; "RTN","DPTLK1",54,0) CHKIFN F DPTIFN=0:0 S DPTIFN=$O(^DPT(DPTREF,DPTVAL,DPTIFN)) Q:'DPTIFN!(DPTDFN)!DPTOUT S Y=DPTIFN D SETDPT I $SDPTLMAX D Q "RTN","DPTLK1",69,0) ..S @DPTLARR@(DPTCNT)="ADDITIONAL MATCHES FOUND BUT NOT RETURNED" "RTN","DPTLK1",70,0) ..S DPTOUT=1 "RTN","DPTLK1",71,0) ..Q "RTN","DPTLK1",72,0) .S @DPTLARR@(DPTCNT)=DPTIFNS(DPTCNT)_U_$$SSN(Y)_U_$$DOB(Y) "RTN","DPTLK1",73,0) .Q "RTN","DPTLK1",74,0) I '(DPTCNT#5),DIC(0)["E" D PRTDPT "RTN","DPTLK1",75,0) Q "RTN","DPTLK1",76,0) ; "RTN","DPTLK1",77,0) PRTDPT I $D(DDS) D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X DDXY S X=0 X ^%ZOSF("RM") "RTN","DPTLK1",78,0) N DPTP1,DPTP2 "RTN","DPTLK1",79,0) F DPTNUM=DPTNUM+1:1:DPTCNT Q:DPTOUT S DPTIFN=+DPTIFNS(DPTNUM) D "RTN","DPTLK1",80,0) .W:'$D(DDS) ! "RTN","DPTLK1",81,0) .S DPTP2=$P(DPTIFNS(DPTNUM),U,3) "RTN","DPTLK1",82,0) .S DPTP1=$P(DPTIFNS(DPTNUM),U,2) "RTN","DPTLK1",83,0) .W ?3,DPTNUM,?$X+(4-$L(DPTNUM)) "RTN","DPTLK1",84,0) .; write the xref value "RTN","DPTLK1",85,0) .W DPTP2_" " "RTN","DPTLK1",86,0) .; write patient name if diff than xref value "RTN","DPTLK1",87,0) .I DPTP1'=DPTP2 W DPTP1 "RTN","DPTLK1",88,0) .S Y=DPTIFN X:$D(^DPT(DPTIFN,0)) "N DDS X DIC(""W"")" I $D(DDS) S DY=DY+1,DX=0 X DDXY S $X=0 "RTN","DPTLK1",89,0) I '$D(DPT("NOPRT^")) W:'$D(DDS) ! W "ENTER '^' TO STOP, OR " "RTN","DPTLK1",90,0) W:'$D(DDS) ! W "CHOOSE ",DPTBEG,"-",DPTNUM,": " R X:DTIME S DPTSEL=X D Q:DPTSEL=""!$D(DTOUT)!$D(DUOUT) "RTN","DPTLK1",91,0) .S:'$T DPTSEL=$S($D(DPTOVAL):DPTOVAL,$D(DPTVAL):DPTVAL,$D(DPTX):DPTX,$D(DPTXOLD):DPTXOLD,1:""),(DPTOUT,DTOUT)=1 "RTN","DPTLK1",92,0) .S:X="^" (DPTOUT,DUOUT)=1 "RTN","DPTLK1",93,0) S DPTDFN=$S(DPTSEL'?.ANP!($L(DPTSEL)>30):-1,'$D(DPTIFNS(DPTSEL)):-1,$D(DPTS(+DPTIFNS(DPTSEL))):+DPTIFNS(DPTSEL),1:-1),DPTX=$S(DPTDFN<0:DPTSEL,1:DPTX) "RTN","DPTLK1",94,0) S:DPTDFN=-1 DPTXOLD=DPTSEL "RTN","DPTLK1",95,0) Q "RTN","DPTLK1",96,0) ; "RTN","DPTLK1",97,0) LIST(DPTX,DPTLMAX,DPTLARR) ;Silent lookup list "RTN","DPTLK1",98,0) ;Input: DPTX=lookup value (name, SSN, room, ward, DFN or "RTN","DPTLK1",99,0) ; "space_return"). "RTN","DPTLK1",100,0) ; DPTLMAX=maximum number of matches to return (optional), this "RTN","DPTLK1",101,0) ; parameter has no effect if DFN or "space_return" "RTN","DPTLK1",102,0) ; lookup methods are used. "RTN","DPTLK1",103,0) ; DPTLARR=name of array to return list of matches, this should "RTN","DPTLK1",104,0) ; be a global if DPTLMAX is a large value or unspecified "RTN","DPTLK1",105,0) ; This array is returned in the format: "RTN","DPTLK1",106,0) ; @DPTLARR@(n)=DFN^patient_name^xref_lookup_match_value^ "RTN","DPTLK1",107,0) ; SSN^Date_of_Birth "RTN","DPTLK1",108,0) ; If more matches exist than the maximum to be returned "RTN","DPTLK1",109,0) ; as specified by DPTLMAX, the @DPTLARR@(DPTLMAX+1) node "RTN","DPTLK1",110,0) ; will be defined = "ADDITIONAL MATCHES FOUND BUT NOT "RTN","DPTLK1",111,0) ; RETURNED". "RTN","DPTLK1",112,0) ; The calling program has the responsibility to kill "RTN","DPTLK1",113,0) ; @DPTLARR prior to calling this entry point. "RTN","DPTLK1",114,0) ;Output: number of matches and array named by DPTLARR. "RTN","DPTLK1",115,0) ; "RTN","DPTLK1",116,0) N X,Y,DPTCNT,DIC,DPTSZ,DPTDFN,DPTIFNS,DPTS "RTN","DPTLK1",117,0) S DPTCNT=0,DIC(0)="M",DPTSZ=1000 S:$G(DPTLMAX)<1 DPTLMAX=0 "RTN","DPTLK1",118,0) ;Check for "space_return" or DFN lookup "RTN","DPTLK1",119,0) I DPTX=" "!($E(DPTX)="`") D Q DPTCNT "RTN","DPTLK1",120,0) .I DPTX=" " S Y=$S('($D(DUZ)#2):-1,$D(^DISV(DUZ,"^DPT(")):^("^DPT("),1:-1) "RTN","DPTLK1",121,0) .I $E(DPTX)="`" S Y=$S($D(^DPT(+$P(DPTX,"`",2),0)):+$P(DPTX,"`",2),1:-1) "RTN","DPTLK1",122,0) .Q:Y<1 Q:'$D(^DPT(Y,0)) D SETDPT S DPTCNT=1 "RTN","DPTLK1",123,0) .Q "RTN","DPTLK1",124,0) D FIND "RTN","DPTLK1",125,0) Q $S(DPTLMAX&(DPTCNT>DPTLMAX):DPTLMAX,1:DPTCNT) "RTN","DPTLK1",126,0) ; "RTN","DPTLK1",127,0) UCASE(DGX) ;Uppercase lookup value "RTN","DPTLK1",128,0) ;Input: DGX=lookup value "RTN","DPTLK1",129,0) ;Output: transformed DGX "RTN","DPTLK1",130,0) N DGI,DGY,DGZ S DGZ=DGX,DGX="" "RTN","DPTLK1",131,0) F DGI=1:1:$L(DGZ) S DGY=$E(DGZ,DGI) D "RTN","DPTLK1",132,0) .S:DGY?1L DGY=$C($A(DGY)-32) "RTN","DPTLK1",133,0) .S DGX=DGX_DGY "RTN","DPTLK1",134,0) Q DGX "RTN","DPTLK1",135,0) ; "RTN","DPTLK1",136,0) SSN(DFN) ;do not show ssn identifier for patient "RTN","DPTLK1",137,0) ; input DFN = ien in file #2 [required] "RTN","DPTLK1",138,0) ; output SSN = nnnnnnnnn "RTN","DPTLK1",139,0) ; "RTN","DPTLK1",140,0) N SSN "RTN","DPTLK1",141,0) S SSN="",DFN=+DFN "RTN","DPTLK1",142,0) I DFN>0 D "RTN","DPTLK1",143,0) .I $$SCREEN(DFN) S SSN="*SENSITIVE*" Q "RTN","DPTLK1",144,0) .S SSN=$P($G(^DPT(DFN,0)),U,9) "RTN","DPTLK1",145,0) Q SSN "RTN","DPTLK1",146,0) ; "RTN","DPTLK1",147,0) DOB(DFN,DGYR) ;do not show dob identifier for patient "RTN","DPTLK1",148,0) ; input DFN = ien in file #2 [required] "RTN","DPTLK1",149,0) ; DGYR = 0/1 [optional] "RTN","DPTLK1",150,0) ; where 0 returns 4-digit year (default) "RTN","DPTLK1",151,0) ; 1 returns 2-digit year "RTN","DPTLK1",152,0) ; 2 returns File manager date "RTN","DPTLK1",153,0) ; output DOB = mm/dd/yyyy (default) "RTN","DPTLK1",154,0) ; = mm/dd/yy, if DGYR=1 "RTN","DPTLK1",155,0) ; = yyymmdd, if DGYR=2 "RTN","DPTLK1",156,0) N B,DOB,YEAR "RTN","DPTLK1",157,0) S DOB="",DFN=+DFN,DGYR=+$G(DGYR) "RTN","DPTLK1",158,0) I DFN>0 D "RTN","DPTLK1",159,0) .I $$SCREEN(DFN) S DOB="*SENSITIVE*" Q "RTN","DPTLK1",160,0) .S B=$P($G(^DPT(DFN,0)),U,3) "RTN","DPTLK1",161,0) .I DGYR'=2 D Q "RTN","DPTLK1",162,0) ..S YEAR=$S(DGYR=1:"2D",1:"5D") "RTN","DPTLK1",163,0) ..S DOB=$$FMTE^XLFDT(B,YEAR) "RTN","DPTLK1",164,0) .S DOB=B "RTN","DPTLK1",165,0) Q DOB "RTN","DPTLK1",166,0) ; "RTN","DPTLK1",167,0) SCREEN(DFN) ;Screening logic for SSN & DOB "RTN","DPTLK1",168,0) ;Input : DFN - Pointer to PATIENT file (#2) "RTN","DPTLK1",169,0) ;Output : 1 - Apply screen "RTN","DPTLK1",170,0) ; 0 - Don't apply screen "RTN","DPTLK1",171,0) ;Notes : Screen applied if patient is sensitive or an employee "RTN","DPTLK1",172,0) ; "RTN","DPTLK1",173,0) N DGTIME,DGT,DGA1,DG1,DGXFR0 "RTN","DPTLK1",174,0) ;Inpatient check - no longer used (kept for future reference) "RTN","DPTLK1",175,0) ;D H^DGUTL S DGT=DGTIME D ^DGPMSTAT I DG1 Q 0 "RTN","DPTLK1",176,0) ;Sensitive - screen "RTN","DPTLK1",177,0) I $P($G(^DGSL(38.1,DFN,0)),"^",2) Q 1 "RTN","DPTLK1",178,0) ;Employee - screen "RTN","DPTLK1",179,0) I $$EMPL^DGSEC4(DFN) Q 1 "RTN","DPTLK1",180,0) ;Don't screen "RTN","DPTLK1",181,0) Q 0 "VER") 8.0^22 **END** **END**