EMERGENCY Released SD*5.3*722 SEQ #592 Extracted from mail message **KIDS**:SD*5.3*722^ **INSTALL NAME** SD*5.3*722 "BLD",10371,0) SD*5.3*722^SCHEDULING^0^3190325^y "BLD",10371,1,0) ^^1^1^3190114^ "BLD",10371,1,1,0) Large Processing Job fix "BLD",10371,4,0) ^9.64PA^409.84^1 "BLD",10371,4,409.84,0) 409.84 "BLD",10371,4,409.84,2,0) ^9.641^409.84^1 "BLD",10371,4,409.84,2,409.84,0) SDEC APPOINTMENT (File-top level) "BLD",10371,4,409.84,2,409.84,1,0) ^9.6411^.05^1 "BLD",10371,4,409.84,2,409.84,1,.05,0) PATIENT "BLD",10371,4,409.84,222) y^y^p^^^^n^^n "BLD",10371,4,409.84,224) "BLD",10371,4,"APDD",409.84,409.84) "BLD",10371,4,"APDD",409.84,409.84,.05) "BLD",10371,4,"B",409.84,409.84) "BLD",10371,6.3) 26 "BLD",10371,"INIT") SD722PST "BLD",10371,"KRN",0) ^9.67PA^779.2^20 "BLD",10371,"KRN",.4,0) .4 "BLD",10371,"KRN",.401,0) .401 "BLD",10371,"KRN",.402,0) .402 "BLD",10371,"KRN",.403,0) .403 "BLD",10371,"KRN",.5,0) .5 "BLD",10371,"KRN",.84,0) .84 "BLD",10371,"KRN",3.6,0) 3.6 "BLD",10371,"KRN",3.8,0) 3.8 "BLD",10371,"KRN",9.2,0) 9.2 "BLD",10371,"KRN",9.8,0) 9.8 "BLD",10371,"KRN",9.8,"NM",0) ^9.68A^8^8 "BLD",10371,"KRN",9.8,"NM",1,0) SD722PST^^0^B512423 "BLD",10371,"KRN",9.8,"NM",2,0) SDEC50^^0^B161237359 "BLD",10371,"KRN",9.8,"NM",3,0) SDEC55A^^0^B89324584 "BLD",10371,"KRN",9.8,"NM",4,0) SDEC07B^^0^B60597834 "BLD",10371,"KRN",9.8,"NM",5,0) SDEC08^^0^B210557907 "BLD",10371,"KRN",9.8,"NM",6,0) SDEC26^^0^B17286312 "BLD",10371,"KRN",9.8,"NM",7,0) SDEC01B^^0^B45849869 "BLD",10371,"KRN",9.8,"NM",8,0) SDEC02^^0^B83466208 "BLD",10371,"KRN",9.8,"NM","B","SD722PST",1) "BLD",10371,"KRN",9.8,"NM","B","SDEC01B",7) "BLD",10371,"KRN",9.8,"NM","B","SDEC02",8) "BLD",10371,"KRN",9.8,"NM","B","SDEC07B",4) "BLD",10371,"KRN",9.8,"NM","B","SDEC08",5) "BLD",10371,"KRN",9.8,"NM","B","SDEC26",6) "BLD",10371,"KRN",9.8,"NM","B","SDEC50",2) "BLD",10371,"KRN",9.8,"NM","B","SDEC55A",3) "BLD",10371,"KRN",19,0) 19 "BLD",10371,"KRN",19,"NM",0) ^9.68A^^ "BLD",10371,"KRN",19.1,0) 19.1 "BLD",10371,"KRN",101,0) 101 "BLD",10371,"KRN",409.61,0) 409.61 "BLD",10371,"KRN",771,0) 771 "BLD",10371,"KRN",779.2,0) 779.2 "BLD",10371,"KRN",870,0) 870 "BLD",10371,"KRN",8989.51,0) 8989.51 "BLD",10371,"KRN",8989.52,0) 8989.52 "BLD",10371,"KRN",8994,0) 8994 "BLD",10371,"KRN","B",.4,.4) "BLD",10371,"KRN","B",.401,.401) "BLD",10371,"KRN","B",.402,.402) "BLD",10371,"KRN","B",.403,.403) "BLD",10371,"KRN","B",.5,.5) "BLD",10371,"KRN","B",.84,.84) "BLD",10371,"KRN","B",3.6,3.6) "BLD",10371,"KRN","B",3.8,3.8) "BLD",10371,"KRN","B",9.2,9.2) "BLD",10371,"KRN","B",9.8,9.8) "BLD",10371,"KRN","B",19,19) "BLD",10371,"KRN","B",19.1,19.1) "BLD",10371,"KRN","B",101,101) "BLD",10371,"KRN","B",409.61,409.61) "BLD",10371,"KRN","B",771,771) "BLD",10371,"KRN","B",779.2,779.2) "BLD",10371,"KRN","B",870,870) "BLD",10371,"KRN","B",8989.51,8989.51) "BLD",10371,"KRN","B",8989.52,8989.52) "BLD",10371,"KRN","B",8994,8994) "BLD",10371,"QDEF") ^^^^NO^^^^NO^^NO "BLD",10371,"QUES",0) ^9.62^^ "BLD",10371,"REQB",0) ^9.611^3^3 "BLD",10371,"REQB",1,0) SD*5.3*672^2 "BLD",10371,"REQB",2,0) SD*5.3*701^2 "BLD",10371,"REQB",3,0) SD*5.3*669^2 "BLD",10371,"REQB","B","SD*5.3*669",3) "BLD",10371,"REQB","B","SD*5.3*672",1) "BLD",10371,"REQB","B","SD*5.3*701",2) "FIA",409.84) SDEC APPOINTMENT "FIA",409.84,0) ^SDEC(409.84, "FIA",409.84,0,0) 409.84D "FIA",409.84,0,1) y^y^p^^^^n^^n "FIA",409.84,0,10) "FIA",409.84,0,11) "FIA",409.84,0,"RLRO") "FIA",409.84,0,"VR") 5.3^SD "FIA",409.84,409.84) 1 "FIA",409.84,409.84,.05) "INIT") SD722PST "IX",409.84,409.84,"APTDT",0) 409.84^APTDT^Allows lookup of appointments for patient by start time^R^^R^IR^I^409.84^^^^^S "IX",409.84,409.84,"APTDT",.1,0) ^^2^2^3190114^ "IX",409.84,409.84,"APTDT",.1,1,0) Cross reference on the PATIENT (#.05) and STARTTIME (#.01) fields "IX",409.84,409.84,"APTDT",.1,2,0) allowing appointments to be found for a given patient and time range. "IX",409.84,409.84,"APTDT",1) S ^SDEC(409.84,"APTDT",$E(X(1),1,30),$E(X(2),1,30),DA)="" "IX",409.84,409.84,"APTDT",2) K ^SDEC(409.84,"APTDT",$E(X(1),1,30),$E(X(2),1,30),DA) "IX",409.84,409.84,"APTDT",2.5) K ^SDEC(409.84,"APTDT") "IX",409.84,409.84,"APTDT",11.1,0) ^.114IA^2^2 "IX",409.84,409.84,"APTDT",11.1,1,0) 1^F^409.84^.05^30^1^F "IX",409.84,409.84,"APTDT",11.1,2,0) 2^F^409.84^.01^30^2^F "MBREQ") 0 "PKG",48,-1) 1^1 "PKG",48,0) SCHEDULING^SD^APPOINTMENTS,PROFILES,LETTERS,AMIS REPORTS "PKG",48,22,0) ^9.49I^1^1 "PKG",48,22,1,0) 5.3^3051119^2960613 "PKG",48,22,1,"PAH",1,0) 722^3190325 "PKG",48,22,1,"PAH",1,1,0) ^^1^1^3190325 "PKG",48,22,1,"PAH",1,1,1,0) Large Processing Job fix "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") NO "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") NO "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") NO "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","SD722PST") 0^1^B512423^n/a "RTN","SD722PST",1,0) SD722PST ; ALB/ZEB - SD*5.3*722 POST-INSTALL ROUTINE ;1/10/19 13:44 "RTN","SD722PST",2,0) ;;5.3;Scheduling;**722**;Aug 13, 1993;Build 26 "RTN","SD722PST",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified "RTN","SD722PST",4,0) ; "RTN","SD722PST",5,0) ; Post-install routine for patch 722. Builds the APTDT cross-reference "RTN","SD722PST",6,0) ; "RTN","SD722PST",7,0) D APTDT "RTN","SD722PST",8,0) Q ;call at tags "RTN","SD722PST",9,0) ; "RTN","SD722PST",10,0) APTDT ;build APTDT cross-reference for patient appointments "RTN","SD722PST",11,0) I '$D(^SDEC("APTDT")) N DIK S DIK="^SDEC(409.84,",DIK(1)=".05^APTDT" D ENALL^DIK "RTN","SD722PST",12,0) Q "RTN","SDEC01B") 0^7^B45849869^B45005907 "RTN","SDEC01B",1,0) SDEC01B ;ALB/SAT - VISTA SCHEDULING RPCS ;APR 08, 2016 "RTN","SDEC01B",2,0) ;;5.3;Scheduling;**627,642,722**;Aug 13, 1993;Build 26 "RTN","SDEC01B",3,0) ; "RTN","SDEC01B",4,0) Q "RTN","SDEC01B",5,0) ; "RTN","SDEC01B",6,0) RESDG(SDRES) ;remove SDEC RESOURCE from all SDEC RESOURCE GROUPs "RTN","SDEC01B",7,0) N SDECY,SDI,SDJ "RTN","SDEC01B",8,0) S SDECY="" "RTN","SDEC01B",9,0) S SDRES=$G(SDRES) Q:'+SDRES Q:'$D(^SDEC(409.831,+SDRES,0)) "RTN","SDEC01B",10,0) S SDI=9999999 F S SDI=$O(^SDEC(409.832,"AB",+SDRES,SDI),-1) Q:SDI="" D "RTN","SDEC01B",11,0) .D DELRGI^SDEC(.SDECY,SDI,SDRES) "RTN","SDEC01B",12,0) Q "RTN","SDEC01B",13,0) ; "RTN","SDEC01B",14,0) RESDGA ;remove all inactive SDEC RESOURCEs from all SDEC RESOURCE GROUPs "RTN","SDEC01B",15,0) N SDI,X "RTN","SDEC01B",16,0) S SDI=0 F S SDI=$O(^SDEC(409.831,SDI)) Q:SDI'>0 S X=$$GET1^DIQ(409.831,SDI_",",.02)="YES" ;computed routine calls RESDG "RTN","SDEC01B",17,0) Q "RTN","SDEC01B",18,0) ; "RTN","SDEC01B",19,0) RESCK(SDRES) ;check if SDEC RESOURCE is inactive ;remove from all SDEC RESOURCE GROUPs if inactive "RTN","SDEC01B",20,0) N X "RTN","SDEC01B",21,0) S SDRES=$G(SDRES) Q:'+SDRES Q:'$D(^SDEC(409.831,+SDRES,0)) "RTN","SDEC01B",22,0) S X=$$GET1^DIQ(409.831,SDRES_",",.02)="YES" ;computed routines calls RESDG "RTN","SDEC01B",23,0) Q "RTN","SDEC01B",24,0) ; "RTN","SDEC01B",25,0) USRDG(SDDUZ) ;remove SDEC RESOURCEs associated with SDDUZ from all SDEC RESOURCE GROUPs "RTN","SDEC01B",26,0) ; SDDUZ = pointer to NEW PERSON file 200 "RTN","SDEC01B",27,0) N SDRES "RTN","SDEC01B",28,0) S SDRES=0 F S SDRES=$O(^SDEC(409.831,"AC","P",SDDUZ,SDRES)) Q:SDRES="" D "RTN","SDEC01B",29,0) .D RESDG(SDRES) "RTN","SDEC01B",30,0) Q "RTN","SDEC01B",31,0) ; "RTN","SDEC01B",32,0) ; "RTN","SDEC01B",33,0) RESPRV1(SDPRV,SDCL,SDPRVN) ;process 1 provider "RTN","SDEC01B",34,0) N EFFDT,EXPDT,PACT,SDFDA,SDIEN,SDMSG,SDRES "RTN","SDEC01B",35,0) ;look for existing resource "RTN","SDEC01B",36,0) S (EFFDT,EXPDT)="" "RTN","SDEC01B",37,0) S SDCL=$G(SDCL) Q:'$D(^SC(+SDCL,0)) "RTN","SDEC01B",38,0) S SDPRV=$G(SDPRV) Q:'$D(^VA(200,+SDPRV,0)) "RTN","SDEC01B",39,0) S SDPRVN=$G(SDPRVN) S:SDPRVN="" SDPRVN=$$GET1^DIQ(200,SDPRV_",",.01) "RTN","SDEC01B",40,0) S SDRES=$O(^SDEC(409.831,"AC","P",SDPRV,0)) "RTN","SDEC01B",41,0) I SDRES'="",$$CHKP(SDPRV,SDRES) Q ;if entry found, update and quit "RTN","SDEC01B",42,0) ;S SDRES=$O(^SDEC(409.831,"B",SDPRVN,0)) ;look for existing SDEC RESOURCE id with provider name "RTN","SDEC01B",43,0) ;I SDRES'="",$$CHKP(SDPRV,SDRES) Q ;if entry found, update and quit "RTN","SDEC01B",44,0) S SDRES="+1" "RTN","SDEC01B",45,0) S PACT=$$PC^SDEC45(SDPRV,DT,.EFFDT,.EXPDT) "RTN","SDEC01B",46,0) S:EXPDT="" EXPDT=DT "RTN","SDEC01B",47,0) ; "RTN","SDEC01B",48,0) K SDFDA,SDIEN,SDMSG "RTN","SDEC01B",49,0) S SDFDA=$NA(SDFDA(409.831,SDRES_",")) "RTN","SDEC01B",50,0) S @SDFDA@(.01)=SDPRVN "RTN","SDEC01B",51,0) S @SDFDA@(.012)=SDPRV_";VA(200," "RTN","SDEC01B",52,0) S @SDFDA@(.015)=$E($$NOW^XLFDT,1,12) "RTN","SDEC01B",53,0) S @SDFDA@(.016)=DUZ "RTN","SDEC01B",54,0) S:+PACT @SDFDA@(.021)=EXPDT "RTN","SDEC01B",55,0) S @SDFDA@(.04)=SDCL "RTN","SDEC01B",56,0) D UPDATE^DIE("","SDFDA","SDIEN","SDMSG") "RTN","SDEC01B",57,0) S SDRES=SDIEN(1) "RTN","SDEC01B",58,0) Q "RTN","SDEC01B",59,0) CHKP(USER,SDRES) ;update existing provider resource entry "RTN","SDEC01B",60,0) ;returns 0=SDRES does not match USER ;1=matches and updated "RTN","SDEC01B",61,0) N EFFDT,EXPDT,RACT,PACT,RSN,RSTS,RSTYP,SDFDA,SCN,SDNOD,SCTS "RTN","SDEC01B",62,0) S RSTYP=$$GET1^DIQ(409.831,SDRES_",",.012,"I") "RTN","SDEC01B",63,0) Q:$P(RSTYP,";",1)'=USER 0 "RTN","SDEC01B",64,0) ; "RTN","SDEC01B",65,0) S SCN=$$GET1^DIQ(200,USER_",",.01) "RTN","SDEC01B",66,0) S RSN=$$GET1^DIQ(409.831,SDRES_",",.01) "RTN","SDEC01B",67,0) S:SCN'=RSN SDFDA(409.831,SDRES_",",.01)=SCN "RTN","SDEC01B",68,0) ; "RTN","SDEC01B",69,0) S (EFFDT,EXPDT)="" "RTN","SDEC01B",70,0) S RACT=$$GET1^DIQ(409.831,SDRES_",",.02) S RACT=$S(RACT="YES":1,1:0) "RTN","SDEC01B",71,0) S PACT=$$PC^SDEC45(USER,DT,.EFFDT,.EXPDT) "RTN","SDEC01B",72,0) I RACT'=PACT D "RTN","SDEC01B",73,0) .S SDNOD=$G(^SDEC(409.831,SDRES,0)) "RTN","SDEC01B",74,0) .I PACT=0 S SDFDA(409.831,SDRES_",",.021)="@",SDFDA(409.831,SDRES_",",.025)="@" "RTN","SDEC01B",75,0) .E S SDFDA(409.831,SDRES_",",.021)=$S(EXPDT="":$$FMADD^XLFDT(DT,-1),EXPDT'>DT:EXPDT,1:$$FMADD^XLFDT(DT,-1)),SDFDA(409.831,SDRES_",",.025)="@" "RTN","SDEC01B",76,0) ; "RTN","SDEC01B",77,0) I $D(SDFDA) D UPDATE^DIE("","SDFDA") "RTN","SDEC01B",78,0) D:+PACT RESCK(SDRES) "RTN","SDEC01B",79,0) Q 1 "RTN","SDEC01B",80,0) ; "RTN","SDEC01B",81,0) CHKC(SDCL,SDRES) ;update existing clinic resource entry "RTN","SDEC01B",82,0) Q ; 722 disabled to stop changing the resource file wtc 2/22/19 "RTN","SDEC01B",83,0) N CINACT,CREACT,RINACT,RREACT,RSN,RSTS,RSTYP,SDFDA,SCN,SCTS "RTN","SDEC01B",84,0) S RSTYP=$$GET1^DIQ(409.831,SDRES_",",.012,"I") "RTN","SDEC01B",85,0) Q:$P(RSTYP,";",1)'=SDCL "RTN","SDEC01B",86,0) ; "RTN","SDEC01B",87,0) S SCN=$$GET1^DIQ(44,SDCL_",",.01) "RTN","SDEC01B",88,0) S RSN=$$GET1^DIQ(409.831,SDRES_",",.01) "RTN","SDEC01B",89,0) S:SCN'=RSN SDFDA(409.831,SDRES_",",.01)=SCN "RTN","SDEC01B",90,0) ; "RTN","SDEC01B",91,0) S CINACT=$$GET1^DIQ(44,SDCL_",",2505,"I") "RTN","SDEC01B",92,0) S RINACT=$$GET1^DIQ(409.831,SDRES_",",.021,"I") "RTN","SDEC01B",93,0) S:CINACT'=RINACT SDFDA(409.831,SDRES_",",.021)=CINACT,SDFDA(409.831,SDRES_",",.022)="@" "RTN","SDEC01B",94,0) S CREACT=$$GET1^DIQ(44,SDCL_",",2506,"I") "RTN","SDEC01B",95,0) S RREACT=$$GET1^DIQ(409.831,SDRES_",",.025) "RTN","SDEC01B",96,0) S:CREACT'=RREACT SDFDA(409.831,SDRES_",",.025)=CREACT,SDFDA(409.831,SDRES_",",.026)="@" "RTN","SDEC01B",97,0) ; "RTN","SDEC01B",98,0) S SCTS=$$GET1^DIQ(44,SDCL_",",1917,"I") S SCTS=$S(SCTS=6:10,SCTS=4:15,SCTS=3:20,SCTS=2:30,1:60) "RTN","SDEC01B",99,0) S RSTS=$$GET1^DIQ(409.831,SDRES_",",.03,"I") "RTN","SDEC01B",100,0) S:SCTS'=RSTS SDFDA(409.831,SDRES_",",.03)=SCTS ;time scale "RTN","SDEC01B",101,0) ; "RTN","SDEC01B",102,0) I $D(SDFDA) D UPDATE^DIE("","SDFDA") "RTN","SDEC01B",103,0) Q "RTN","SDEC01B",104,0) ; "RTN","SDEC01B",105,0) RESCLIN1(SDCL) ; "RTN","SDEC01B",106,0) N SDCLN,SDDATA,SDFDA,SDFIELDS,SDFOUND,SDIEN,SDIN,SDLET,SDMSG,SDRES11,SDRESH,SDRN,SDMSG,SDTS,SDWP "RTN","SDEC01B",107,0) S SDFOUND=0 "RTN","SDEC01B",108,0) ; .01 name; 2 type; 1912 len of appt; 2508 no show let; 2509 pre-appt let; 2510 clinic can let; "RTN","SDEC01B",109,0) S SDFIELDS=".01;2;50.01;1912;1917;2505;2506;2508;2509;2510" "RTN","SDEC01B",110,0) D GETS^DIQ(44,SDCL_",",SDFIELDS,"IE","SDDATA","SDMSG") "RTN","SDEC01B",111,0) I SDDATA(44,SDCL_",",2,"I")="C" D "RTN","SDEC01B",112,0) .;Q:SDDATA(44,SDCL_",",50.01,"I")=1 ;OOS? "RTN","SDEC01B",113,0) .S SDIN=SDDATA(44,SDCL_",",2505,"I"),SDRN=SDDATA(44,SDCL_",",2506,"I") "RTN","SDEC01B",114,0) .Q:$$INACT(SDIN,SDRN) "RTN","SDEC01B",115,0) .S SDCLN=SDDATA(44,SDCL_",",.01,"E") ;clinic name "RTN","SDEC01B",116,0) .;look for existing to allow this post-init to be re-entrant "RTN","SDEC01B",117,0) .S SDRESH=0 F S SDRESH=$O(^SDEC(409.831,"ALOC",SDCL,SDRESH)) Q:SDRESH'>0 D Q:+SDFOUND "RTN","SDEC01B",118,0) ..S SDRES11=$$GET1^DIQ(409.831,SDRESH_",",.012,"I") "RTN","SDEC01B",119,0) ..I $P(SDRES11,";",2)="SC(",$P(SDRES11,";",1)=SDCL S SDFOUND=1 "RTN","SDEC01B",120,0) .I +SDFOUND D CHKC(SDCL,SDRESH) Q "RTN","SDEC01B",121,0) .S SDRESH=$O(^SDEC(409.831,"B",$$UP^XLFSTR(SDCLN),0)) ;look for existing SDEC RESOURCE id with clinic name "RTN","SDEC01B",122,0) .I SDRESH'="" Q "RTN","SDEC01B",123,0) .S SDRESH="+1" "RTN","SDEC01B",124,0) .K SDFDA,SDIEN,SDMSG "RTN","SDEC01B",125,0) .S SDFDA=$NA(SDFDA(409.831,SDRESH_",")) "RTN","SDEC01B",126,0) .S @SDFDA@(.01)=SDCLN "RTN","SDEC01B",127,0) .S @SDFDA@(.012)=SDCL_";SC(" "RTN","SDEC01B",128,0) .S @SDFDA@(.015)=$E($$NOW^XLFDT,1,12) "RTN","SDEC01B",129,0) .S @SDFDA@(.016)=DUZ "RTN","SDEC01B",130,0) .I SDDATA(44,SDCL_",",2505,"I")'="" S @SDFDA@(.021)=SDDATA(44,SDCL_",",2505,"I") "RTN","SDEC01B",131,0) .I SDDATA(44,SDCL_",",2506,"I")'="" S @SDFDA@(.025)=SDDATA(44,SDCL_",",2506,"I") "RTN","SDEC01B",132,0) .S SDTS=SDDATA(44,SDCL_",",1917,"I") S @SDFDA@(.03)=$S(SDTS=5:5,SDTS=6:10,SDTS=4:15,SDTS=3:20,SDTS=2:30,SDTS=45:15,1:60) ;time scale "RTN","SDEC01B",133,0) .S @SDFDA@(.04)=SDCL "RTN","SDEC01B",134,0) .D UPDATE^DIE("","SDFDA","SDIEN","SDMSG") "RTN","SDEC01B",135,0) .I $D(SDMSG) W !,"RESCLIN: Unable to store clinic "_SDCL_" in resource." Q "RTN","SDEC01B",136,0) .S SDRESH=SDIEN(1) "RTN","SDEC01B",137,0) .;get letter text "RTN","SDEC01B",138,0) .S SDLET=SDDATA(44,SDCL_",",2509,"I") "RTN","SDEC01B",139,0) .D RESLET(SDLET,.SDWP) "RTN","SDEC01B",140,0) .I $D(SDWP) D WP^DIE(409.831,SDRESH_",",1,"","SDWP") "RTN","SDEC01B",141,0) .;get no show letter "RTN","SDEC01B",142,0) .S SDLET=SDDATA(44,SDCL_",",2508,"I") "RTN","SDEC01B",143,0) .D RESLET(SDLET,.SDWP) "RTN","SDEC01B",144,0) .I $D(SDWP) D WP^DIE(409.831,SDRESH_",",1201,"","SDWP") "RTN","SDEC01B",145,0) .;get clinic cancellation letter "RTN","SDEC01B",146,0) .S SDLET=SDDATA(44,SDCL_",",2510,"I") "RTN","SDEC01B",147,0) .D RESLET(SDLET,.SDWP) "RTN","SDEC01B",148,0) .I $D(SDWP) D WP^DIE(409.831,SDRESH_",",1301,"","SDWP") "RTN","SDEC01B",149,0) Q "RTN","SDEC01B",150,0) RESLET(SDLET,SDWP) ;get letter text "RTN","SDEC01B",151,0) ;INPUT: "RTN","SDEC01B",152,0) ; SDLET - Letter ID pointer to LETTER file 407.5 "RTN","SDEC01B",153,0) ;RETURN "RTN","SDEC01B",154,0) ; .SDWP - Word Processor array used to store text using WP^DIE "RTN","SDEC01B",155,0) N SDMSG,SDWPI,SDWPJ,SDWP2,SDWP3,X "RTN","SDEC01B",156,0) S X=$$GET1^DIQ(407.5,SDLET_",",2,"","SDWP2","SDMSG") "RTN","SDEC01B",157,0) Q:$D(SDMSG) "RTN","SDEC01B",158,0) S X=$$GET1^DIQ(407.5,SDLET_",",3,"","SDWP3","SDMSG") "RTN","SDEC01B",159,0) S SDWPI=0 "RTN","SDEC01B",160,0) S SDWPJ="" F S SDWPJ=$O(SDWP2(SDWPJ)) Q:SDWPJ="" S SDWPI=SDWPI+1 S SDWP(SDWPI)=SDWP2(SDWPJ) "RTN","SDEC01B",161,0) S SDWPJ="" F S SDWPJ=$O(SDWP3(SDWPJ)) Q:SDWPJ="" S SDWPI=SDWPI+1 S SDWP(SDWPI)=SDWP3(SDWPJ) "RTN","SDEC01B",162,0) Q "RTN","SDEC01B",163,0) INACT(SDIN,SDRN) ; "RTN","SDEC01B",164,0) ;0=ACTIVATE "RTN","SDEC01B",165,0) ;1=INACTIVE "RTN","SDEC01B",166,0) N NOW,RET "RTN","SDEC01B",167,0) S RET=0 "RTN","SDEC01B",168,0) S NOW=$P($$NOW^XLFDT,".",1) "RTN","SDEC01B",169,0) S SDIN=$P($G(SDIN),".",1) "RTN","SDEC01B",170,0) S SDRN=$P($G(SDRN),".",1) "RTN","SDEC01B",171,0) Q:SDIN="" 0 ;no inactive date "RTN","SDEC01B",172,0) Q:NOWNOW D "RTN","SDEC01B",174,0) .;MGH added one more check on dates "RTN","SDEC01B",175,0) .S RET=$S(SDRN="":1,SDRN'>NOW:0,SDRN>SDIN:0,1:1) "RTN","SDEC01B",176,0) Q RET "RTN","SDEC02") 0^8^B83466208^B68680067 "RTN","SDEC02",1,0) SDEC02 ;ALB/SAT - VISTA SCHEDULING RPCS ;MAR 15, 2017 "RTN","SDEC02",2,0) ;;5.3;Scheduling;**627,642,658,672,722**;Aug 13, 1993;Build 26 "RTN","SDEC02",3,0) ; "RTN","SDEC02",4,0) Q "RTN","SDEC02",5,0) ; "RTN","SDEC02",6,0) CRSCHED(SDECY,SDECRES,SDECSTART,SDECEND,SDECWKIN,MAXREC,LASTSUB) ;Create Resource Appointment Schedule ;alb/sat 672 "RTN","SDEC02",7,0) ;CRSCHED(SDECY,SDECRES,SDECSTART,SDECEND,SDECWKIN) external parameter tag is in SDEC "RTN","SDEC02",8,0) ;Create Resource Appointment Schedule recordset "RTN","SDEC02",9,0) ;On error, returns 0 in APPOINTMENTID field and error text in NOTE field "RTN","SDEC02",10,0) ; "RTN","SDEC02",11,0) ;$O Thru ^SDEC(409.84,"ARSRC", RESOURCE, STARTTIME, APPTID) "RTN","SDEC02",12,0) ;SDECRES - pipe | delimited list of resource names "RTN","SDEC02",13,0) ;SDECSTART - Start date/time in external form "RTN","SDEC02",14,0) ;SDECEND - End Date/time in external form "RTN","SDEC02",15,0) ;SDECWKIN - Include Walk-ins 1=return walkins; 0=skip walk-ins "RTN","SDEC02",16,0) ;9-27-2004 Added walkin to returned datatable "RTN","SDEC02",17,0) ;TODO: Change SDECRES from names to IDs "RTN","SDEC02",18,0) ;RETURN: "RTN","SDEC02",19,0) ; Global Array in which each array entry contains data for the Resource Appointment Schedule separated by ^: "RTN","SDEC02",20,0) ; 1. APPOINTMENTID "RTN","SDEC02",21,0) ; 2. START_TIME "RTN","SDEC02",22,0) ; 3. END_TIME "RTN","SDEC02",23,0) ; 4. CHECKIN "RTN","SDEC02",24,0) ; 5. AUXTIME "RTN","SDEC02",25,0) ; 6. PATIENTID "RTN","SDEC02",26,0) ; 7. PATIENTNAME "RTN","SDEC02",27,0) ; 8. RESOURCENAME "RTN","SDEC02",28,0) ; 9. NOSHOW "RTN","SDEC02",29,0) ;10. HRN "RTN","SDEC02",30,0) ;11. ACCESSTYPEID "RTN","SDEC02",31,0) ;12. WALKIN "RTN","SDEC02",32,0) ;13. CHECKOUT "RTN","SDEC02",33,0) ;14. VPROVIDER "RTN","SDEC02",34,0) ;15. CANCELLED "RTN","SDEC02",35,0) ;16. NOTE "RTN","SDEC02",36,0) ;17. DAPTDT "RTN","SDEC02",37,0) ;18. APPTREQTYPE "RTN","SDEC02",38,0) ;19. DIEDON "RTN","SDEC02",39,0) ;20. EESTAT - Patient Status N=NEW E=ESTABLISHED "RTN","SDEC02",40,0) ;21. MULT - data from MULT APPTS MADE field of SDEC APPT REQUEST separated by pipe ;alb/sat 642 "RTN","SDEC02",41,0) ; each pipe piece contains the following ~ pieces: "RTN","SDEC02",42,0) ; 1. MULT APPTS MADE - pointer to SDEC APPOINTMENT "RTN","SDEC02",43,0) ; 2. PARENT REQUEST - pointer to SDEC APPT REQUEST "RTN","SDEC02",44,0) ;22. SDPARENT - PARENT REQUEST from SDEC APPT REQUEST. Pointer to SDEC APPT REQUEST. ;alb/sat 642 "RTN","SDEC02",45,0) ; "RTN","SDEC02",46,0) N SDECERR,SDECIEN,SDECDEPD,SDECDEPN,SDECRESD,SDECI,SDECJ,SDECRESN,SDECS,SDECAD,SDECZ,SDECQ,SDECNOD,SDECTMP "RTN","SDEC02",47,0) N SDECPAT,SDECNOT,SDECZPCD,SDECPCD,SDDDT,SDAPTYP "RTN","SDEC02",48,0) N SDCNT,SDI ;alb/sat 672 "RTN","SDEC02",49,0) N %DT,X,Y "RTN","SDEC02",50,0) K ^TMP("SDEC02",$J) "RTN","SDEC02",51,0) S SDECERR="" "RTN","SDEC02",52,0) S SDCNT=0 ;alb/sat 672 "RTN","SDEC02",53,0) S SDECY="^TMP(""SDEC02"","_$J_")" "RTN","SDEC02",54,0) ; 1 2 3 4 5 6 "RTN","SDEC02",55,0) S SDECTMP="I00020APPOINTMENTID^D00030START_TIME^D00030END_TIME^D00030CHECKIN^D00030AUXTIME^I00020PATIENTID^" "RTN","SDEC02",56,0) ; 7 8 9 10 11 12 "RTN","SDEC02",57,0) S SDECTMP=SDECTMP_"T00030PATIENTNAME^T00030RESOURCENAME^I00005NOSHOW^T00020HRN^I00005ACCESSTYPEID^I00005WALKIN^" "RTN","SDEC02",58,0) ; 13 14 15 16 17 18 "RTN","SDEC02",59,0) S SDECTMP=SDECTMP_"D00030CHECKOUT^I00020VPROVIDER^T00020CANCELLED^T00250NOTE^T00030DAPTDT^T00030APPTREQTYPE^" "RTN","SDEC02",60,0) ;alb/sat 642 added MULT and SDPARENT ;alb/sat 672 added SLAST,SSN,DOB,SENSITIVE "RTN","SDEC02",61,0) S SDECTMP=SDECTMP_"T00030DIEDON^T00030EESTAT^T00250MULT^T00030SDPARENT^T00050SDLAST^T00030SSN^T00030DOB^T00100SENSITIVE" "RTN","SDEC02",62,0) S ^TMP("SDEC02",$J,0)=SDECTMP_$C(30) "RTN","SDEC02",63,0) ; "RTN","SDEC02",64,0) S:SDECSTART["@0000" SDECSTART=$P(SDECSTART,"@") "RTN","SDEC02",65,0) S:SDECEND["@0000" SDECEND=$P(SDECEND,"@") "RTN","SDEC02",66,0) S %DT="T",X=SDECSTART D ^%DT S SDECSTART=Y "RTN","SDEC02",67,0) I SDECSTART=-1 S ^TMP("SDEC02",$J,0)=^TMP("SDEC02",$J,0)_$C(31) Q "RTN","SDEC02",68,0) S %DT="T",X=SDECEND D ^%DT S SDECEND=Y "RTN","SDEC02",69,0) I SDECEND=-1 S ^TMP("SDEC02",$J,0)=^TMP("SDEC02",$J,0)_$C(31) Q "RTN","SDEC02",70,0) S MAXREC=$G(MAXREC) S:'MAXREC MAXREC=9999999 ;alb/sat 672 "RTN","SDEC02",71,0) S LASTSUB=$G(LASTSUB) ;alb/sat 672 "RTN","SDEC02",72,0) ; "RTN","SDEC02",73,0) S SDECI=0 "RTN","SDEC02",74,0) D STRES "RTN","SDEC02",75,0) ; "RTN","SDEC02",76,0) S ^TMP("SDEC02",$J,SDECI)=^TMP("SDEC02",$J,SDECI)_$C(31) "RTN","SDEC02",77,0) Q "RTN","SDEC02",78,0) ; "RTN","SDEC02",79,0) STRES ; "RTN","SDEC02",80,0) S SDI=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1),1:1) ;alb/sat 672 "RTN","SDEC02",81,0) N SDECRESA,SDECRSND,SDECREST,SDCL,NEWRES,SDRSLTS ;*zeb+34 722 1/17/19 include appts for resources that share clinics "RTN","SDEC02",82,0) I SDECRES["|" D I 1 "RTN","SDEC02",83,0) . S SDECRESA=SDECRES "RTN","SDEC02",84,0) E D "RTN","SDEC02",85,0) . S SDECRESA="|"_SDECRES_"|" "RTN","SDEC02",86,0) . I '+SDECRES Q:'$D(^SDEC(409.831,"B",SDECRES)) "RTN","SDEC02",87,0) . I '+SDECRES S SDECRES=$O(^SDEC(409.831,"B",SDECRES,0)) "RTN","SDEC02",88,0) . S SDECRSND=$G(^SDEC(409.831,SDECRES,0)) "RTN","SDEC02",89,0) . S SDECRST=$P($P(SDECRSND,U,11),";",2) "RTN","SDEC02",90,0) . I SDECRST'="SC(" D Q "RTN","SDEC02",91,0) . . S SDECRESA=SDECRESA_"|"_SDECRES "RTN","SDEC02",92,0) . S SDCL=$P(SDECRSND,U,4) "RTN","SDEC02",93,0) . S NEWRES="" "RTN","SDEC02",94,0) . F S NEWRES=$O(^SDEC(409.831,"ALOC",SDCL,NEWRES)) Q:NEWRES="" D "RTN","SDEC02",95,0) . . Q:NEWRES=SDECRES "RTN","SDEC02",96,0) . . S SDECRESA=SDECRESA_"|"_NEWRES_U_$P(^SDEC(409.831,SDECRES,0),U,1) "RTN","SDEC02",97,0) F SDECJ=1:1:$L(SDECRESA,"|") S SDECRESN=$P(SDECRESA,"|",SDECJ) D "RTN","SDEC02",98,0) . Q:SDECRESN="" "RTN","SDEC02",99,0) . S SDECOVR="" "RTN","SDEC02",100,0) . I SDECRESN[U S SDECOVR=$P(SDECRESN,U,2),SDECRESD=$P(SDECRESN,U,1) "RTN","SDEC02",101,0) . E S SDECRESD=SDECRESN "RTN","SDEC02",102,0) . ;I +SDECRESN Q:'$D(^SDEC(409.831,+SDECRESN,0)) "RTN","SDEC02",103,0) . ;I +SDECRESN S SDECRESD=SDECRESN "RTN","SDEC02",104,0) . ;I '+SDECRESN Q:'$D(^SDEC(409.831,"B",SDECRESN)) "RTN","SDEC02",105,0) . ;I '+SDECRESN S SDECRESD=$O(^SDEC(409.831,"B",SDECRESN,0)) "RTN","SDEC02",106,0) . ;Q:'+SDECRESD "RTN","SDEC02",107,0) . S SDECRESN=$P($G(^SDEC(409.831,SDECRESD,0)),U,1) "RTN","SDEC02",108,0) . ;Q:'$D(^SDEC(409.84,"ARSRC",SDECRESD)) "RTN","SDEC02",109,0) . S SDECS=$S($P(LASTSUB,"|",2):$P(LASTSUB,"|",2),1:SDECSTART)-.0001 ;alb/sat 672 "RTN","SDEC02",110,0) . F S SDECS=$O(^SDEC(409.84,"ARSRC",SDECRESD,SDECS)) Q:'+SDECS Q:SDECS>SDECEND D Q:SDCNT'0 S SDECHRN=$P($G(^AUPNPAT(SDECPATD,41,DUZ(2),0)),U,2) ;HRN "RTN","SDEC02",148,0) S $P(SDECZ,"^",10)=SDECHRN "RTN","SDEC02",149,0) S SDECATID=$P(SDECNOD,U,6) "RTN","SDEC02",150,0) S:'+SDECATID SDECATID=0 ;UNKNOWN TYPE "RTN","SDEC02",151,0) S $P(SDECZ,"^",11)=SDECATID "RTN","SDEC02",152,0) S $P(SDECZ,"^",12)=SDECISWK "RTN","SDEC02",153,0) S $P(SDECZ,"^",13)=SDECCO ;CHECKOUT TIME "RTN","SDEC02",154,0) S $P(SDECZ,"^",14)=SDECVPRV ;POINTER TO NEW PERSON "RTN","SDEC02",155,0) S $P(SDECZ,"^",15)=SDECCAN ;CANCELLED "RTN","SDEC02",156,0) ;NOTE [16] "RTN","SDEC02",157,0) S SDECNOT="",SDECQ=0 F S SDECQ=$O(^SDEC(409.84,SDECAD,1,SDECQ)) Q:'+SDECQ D "RTN","SDEC02",158,0) . S SDECNOT=$G(^SDEC(409.84,SDECAD,1,SDECQ,0)) "RTN","SDEC02",159,0) . S:$E(SDECNOT,$L(SDECNOT)-1,$L(SDECNOT))'=" " SDECNOT=SDECNOT_" " "RTN","SDEC02",160,0) . S SDTMP=SDTMP_$S(SDTMP'="":" ",1:"")_$TR(SDECNOT,"^"," ") ;alb/sat 672 "RTN","SDEC02",161,0) . ;S SDECI=SDECI+1 ;alb/sat 672 - removed "RTN","SDEC02",162,0) . ;S ^TMP("SDEC02",$J,SDECI)=$TR(SDECNOT,"^"," ") ;alb/sat 658 ;alb/sat 672 - removed "RTN","SDEC02",163,0) ;S ^TMP("SDEC02",$J,SDECI)=^TMP("SDEC02",$J,SDECI)_"^" ;alb/sat 672 - replaced "RTN","SDEC02",164,0) S $P(SDECZ,"^",16)=SDTMP ;alb/sat 672 "RTN","SDEC02",165,0) ;additional data "RTN","SDEC02",166,0) ;S SDECZ="" ;alb/sat 672 - removed "RTN","SDEC02",167,0) S $P(SDECZ,"^",17)=$S($P(SDECNOD,U,20)'="":$$FMTE^XLFDT($P(SDECNOD,U,20)),1:"") ;alb/sat 672 "RTN","SDEC02",168,0) ;appt request type "RTN","SDEC02",169,0) S SDAPTYP=$P($G(^SDEC(409.84,SDECAD,2)),U,1) "RTN","SDEC02",170,0) S:SDAPTYP'="" SDAPTYP=$S($P(SDAPTYP,";",2)["SDWL":"E",$P(SDAPTYP,";",2)["GMR":"C",$P(SDAPTYP,";",2)="SD(403.5,":"R",$P(SDAPTYP,";",2)="SDEC(409.85,":"A",1:"")_"|"_$P(SDAPTYP,";",1) "RTN","SDEC02",171,0) S $P(SDECZ,"^",18)=SDAPTYP ;[18] ;alb/sat 672 "RTN","SDEC02",172,0) S DIEDON="" D DIEDON^ORWPT(.DIEDON,SDECPATD) "RTN","SDEC02",173,0) S $P(SDECZ,"^",19)=DIEDON ;[19] ;alb/sat 672 "RTN","SDEC02",174,0) S $P(SDECZ,"^",20)=$$GET1^DIQ(409.84,SDECAD_",",.23,"E") ;[20] ;alb/sat 672 "RTN","SDEC02",175,0) I $P(SDAPTYP,"|",1)="A" S $P(SDECZ,"^",21)=$$MULT(SDAPTYP) ;[21] [22] alb/sat 642 ;alb/sat 672 "RTN","SDEC02",176,0) I $P(SDAPTYP,"|",1)="A" S $P(SDECZ,"^",22)=$$GET1^DIQ(409.85,$P(SDAPTYP,"|",2)_",",43.8,"I") ;[21] [22] alb/sat 642 ;alb/sat 672 "RTN","SDEC02",177,0) S $P(SDECZ,"^",24)=$G(SDDEMO("SSN")) ;[24] ;alb/sat 672 - added "RTN","SDEC02",178,0) S $P(SDECZ,"^",25)=$G(SDDEMO("DOB")) ;[25] ;alb/sat 672 - added "RTN","SDEC02",179,0) S SDSENS=$$PTSEC^SDECUTL(SDECPATD) S $P(SDECZ,"^",26)=SDSENS ;[26] ;alb/sat 672 - added "RTN","SDEC02",180,0) S SDCNT=SDCNT+1 I SDCNT'0 D Q:CHECKIN'="" "RTN","SDEC02",191,0) .S SDNOD=$G(^SC(SDCL,"S",SDT,1,SDI,0)) "RTN","SDEC02",192,0) .Q:$P(SDNOD,U,1)'=DFN "RTN","SDEC02",193,0) .I $D(^SC(SDCL,"S",SDT,1,SDI,"C")) D "RTN","SDEC02",194,0) ..S CHECKIN=$P($G(^SC(SDCL,"S",SDT,1,SDI,"C")),U,1) "RTN","SDEC02",195,0) ..S ENTERED=$P($G(^SC(SDCL,"S",SDT,1,SDI,"C")),U,5) "RTN","SDEC02",196,0) ..S:CHECKIN'="" SDFDA(409.84,APPT_",",.03)=CHECKIN "RTN","SDEC02",197,0) ..S:ENTERED'="" SDFDA(409.84,APPT_",",.04)=ENTERED "RTN","SDEC02",198,0) ..D:$D(SDFDA) UPDATE^DIE("","SDFDA") "RTN","SDEC02",199,0) ..S Y=CHECKIN "RTN","SDEC02",200,0) ..X ^DD("DD") S CHECKIN=$TR(Y,"@"," ") "RTN","SDEC02",201,0) ..S Y=ENTERED "RTN","SDEC02",202,0) ..X ^DD("DD") S ENTERED=$TR(Y,"@"," ") "RTN","SDEC02",203,0) Q CHECKIN_U_ENTERED "RTN","SDEC02",204,0) MULT(SDAPTYP) ;get data from MULT APPTS MADE field of SDEC APPT REQUEST file ;alb/sat 642 "RTN","SDEC02",205,0) N ARIEN,SDI,MULT1,MULTL "RTN","SDEC02",206,0) S MULTL="" "RTN","SDEC02",207,0) S ARIEN=$P(SDAPTYP,"|",2) "RTN","SDEC02",208,0) S SDI=0 F S SDI=$O(^SDEC(409.85,ARIEN,2,SDI)) Q:SDI'>0 D "RTN","SDEC02",209,0) .S MULT1=$P($G(^SDEC(409.85,ARIEN,2,SDI,0)),"^",1) "RTN","SDEC02",210,0) .S MULTL=$S(MULTL'="":MULTL_"|",1:"")_MULT1 "RTN","SDEC02",211,0) Q MULTL "RTN","SDEC02",212,0) ; "RTN","SDEC02",213,0) ERR(SDECI,SDECERR) ;Error processing "RTN","SDEC02",214,0) S SDECI=SDECI+1 "RTN","SDEC02",215,0) S ^TMP("SDEC02",$J,SDECI)="0^^^^^^^^^^^"_SDECERR_$C(30) "RTN","SDEC02",216,0) S SDECI=SDECI+1 "RTN","SDEC02",217,0) S ^TMP("SDEC02",$J,SDECI)=$C(31) "RTN","SDEC02",218,0) Q "RTN","SDEC02",219,0) ; "RTN","SDEC02",220,0) ETRAP ;EP Error trap entry "RTN","SDEC02",221,0) D ^%ZTER "RTN","SDEC02",222,0) I '$D(SDECI) N SDECI S SDECI=999999 "RTN","SDEC02",223,0) S SDECI=SDECI+1 "RTN","SDEC02",224,0) D ERR(SDECI,"SDEC31 Error") "RTN","SDEC02",225,0) Q "RTN","SDEC07B") 0^4^B60597834^B86344811 "RTN","SDEC07B",1,0) SDEC07B ;ALB/SAT - VISTA SCHEDULING RPCS ;MAY 15, 2017 "RTN","SDEC07B",2,0) ;;5.3;Scheduling;**627,658,665,669,722**;Aug 13, 1993;Build 26 "RTN","SDEC07B",3,0) ; "RTN","SDEC07B",4,0) Q "RTN","SDEC07B",5,0) ; "RTN","SDEC07B",6,0) MAKE(BSDR) ;PEP; call to store appt made "RTN","SDEC07B",7,0) ; "RTN","SDEC07B",8,0) ; Make call using: S ERR=$$MAKE^SDEC07B(.ARRAY) "RTN","SDEC07B",9,0) ; "RTN","SDEC07B",10,0) ; Input Array - "RTN","SDEC07B",11,0) ; BSDR("PAT") = ien of patient in file 2 "RTN","SDEC07B",12,0) ; BSDR("CLN") = ien of clinic in file 44 "RTN","SDEC07B",13,0) ; BSDR("TYP") = C&P if appointment type is C&P, 3 for scheduled appts, 4 for walkins "RTN","SDEC07B",14,0) ; BSDR("COL") = collateral if appointment type is COLLATERAL OF VET. "RTN","SDEC07B",15,0) ; BSDR("APT") = Appointment type pointer to APPOINTMENT TYPE file 409.1 "RTN","SDEC07B",16,0) ; BSDR("ADT") = appointment date and time "RTN","SDEC07B",17,0) ; BSDR("LEN") = appointment length in minutes (5-120) "RTN","SDEC07B",18,0) ; BSDR("OI") = reason for appt - up to 150 characters "RTN","SDEC07B",19,0) ; BSDR("USR") = user who made appt "RTN","SDEC07B",20,0) ; BSDR("RES") = resource pointer to SDEC RESOURCE ^SDEC(409.831, "RTN","SDEC07B",21,0) ; BSDR("MTR") = MTRC flag (multiple appointments) 0=False (default) 1=True "RTN","SDEC07B",22,0) ; BSDR("DDT") = Desired Date of Appt in fm format "RTN","SDEC07B",23,0) ; BSDR("REQ") = Requested By - valid values are 1=PROVIDER 2=PATIENT or "" "RTN","SDEC07B",24,0) ; BSDR("LAB") = LAB date/time in fm format "RTN","SDEC07B",25,0) ; BSDR("EKG") = EKG date/time in fm format "RTN","SDEC07B",26,0) ; BSDR("XRA") = XRAY date/time in fm format "RTN","SDEC07B",27,0) ; BSDR("CON") = Consult link - pointer to file 123 "RTN","SDEC07B",28,0) ; BSDR("OVB") = overbook flag - 1=yes, this is an overbook "RTN","SDEC07B",29,0) ; BSDR("ELG") = Patient Eligibilty "RTN","SDEC07B",30,0) ; "RTN","SDEC07B",31,0) ;Output: error status and message "RTN","SDEC07B",32,0) ; = 0 or null: everything okay "RTN","SDEC07B",33,0) ; = 1^message: error and reason "RTN","SDEC07B",34,0) ; "RTN","SDEC07B",35,0) I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) "RTN","SDEC07B",36,0) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) "RTN","SDEC07B",37,0) I "1234"'[$G(BSDR("TYP")) Q 1_U_"Appt Type error: "_$G(BSDR("TYP")) "RTN","SDEC07B",38,0) I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds "RTN","SDEC07B",39,0) I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) "RTN","SDEC07B",40,0) ; "RTN","SDEC07B",41,0) I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN")) "RTN","SDEC07B",42,0) I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) "RTN","SDEC07B",43,0) I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U,2)'="C",$P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U,2)'="PC" Q 1_U_"Patient "_$$GET1^DIQ(2,BSDR("PAT")_",",.01)_" already has appt at "_$$FMTE^XLFDT(BSDR("ADT")) "RTN","SDEC07B",44,0) ; "RTN","SDEC07B",45,0) N DIC,DA,Y,X,DD,DO,DLAYGO "RTN","SDEC07B",46,0) N SDECERR "RTN","SDEC07B",47,0) N SDFU,SDNA,SDRET,SDSRT "RTN","SDEC07B",48,0) ; "RTN","SDEC07B",49,0) S BSDR("APT")=+$G(BSDR("APT")) "RTN","SDEC07B",50,0) S BSDR("COL")=+$G(BSDR("COL")) "RTN","SDEC07B",51,0) ;get scheduling request type AND next ava. appt. indicator "RTN","SDEC07B",52,0) S SDSRT=$$SDSRT(BSDR("TYP"),BSDR("MTR"),BSDR("DDT"),BSDR("REQ")) "RTN","SDEC07B",53,0) ; next ava.appt. indicator field 26 "RTN","SDEC07B",54,0) S SDNA=$P(SDSRT,U,2) "RTN","SDEC07B",55,0) ; scheduling request type field 25 "RTN","SDEC07B",56,0) S SDSRT=$P(SDSRT,U,1) "RTN","SDEC07B",57,0) ;determine if Follow-up visit field 28 "RTN","SDEC07B",58,0) S SDRET="" "RTN","SDEC07B",59,0) D PCSTGET^SDEC(.SDRET,BSDR("PAT"),BSDR("CLN")) "RTN","SDEC07B",60,0) S SDFU=$P($P(@SDRET@(1),U,2),$C(30,31),1) "RTN","SDEC07B",61,0) S SDFU=$S(SDFU="YES":1,1:0) "RTN","SDEC07B",62,0) K @SDRET "RTN","SDEC07B",63,0) ;store "RTN","SDEC07B",64,0) I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),(($P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U,2)="C")!($P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U,2)="PC")) D "RTN","SDEC07B",65,0) . ; "un-cancel" existing appt in file 2 "RTN","SDEC07B",66,0) . N SDECFDA,SDECIENS,SDECMSG "RTN","SDEC07B",67,0) . S SDECIENS=BSDR("ADT")_","_BSDR("PAT")_"," "RTN","SDEC07B",68,0) . S SDECFDA(2.98,SDECIENS,".01")=$$NULLDEL(BSDR("CLN")) ;*zeb+19 722 2/19/19 completely replace old appt's data if overlaying; prevent chimera appt "RTN","SDEC07B",69,0) . S SDECFDA(2.98,SDECIENS,"3")=$$NULLDEL($S($G(^DPT(+$G(BSDR("PAT")),.1))'="":"I",1:"")) "RTN","SDEC07B",70,0) . S SDECFDA(2.98,SDECIENS,"5")=$$NULLDEL(BSDR("LAB")) ;lab date/time "RTN","SDEC07B",71,0) . S SDECFDA(2.98,SDECIENS,"6")=$$NULLDEL(BSDR("XRA")) ;xray date/time "RTN","SDEC07B",72,0) . S SDECFDA(2.98,SDECIENS,"7")=$$NULLDEL(BSDR("EKG")) ;ekg date/time "RTN","SDEC07B",73,0) . S SDECFDA(2.98,SDECIENS,"9")=$$NULLDEL(BSDR("TYP")) "RTN","SDEC07B",74,0) . S SDECFDA(2.98,SDECIENS,"9.5")=$$NULLDEL(BSDR("APT")) "RTN","SDEC07B",75,0) . S SDECFDA(2.98,SDECIENS,"13")=$$NULLDEL(BSDR("COL")) "RTN","SDEC07B",76,0) . S SDECFDA(2.98,SDECIENS,"14")="@" "RTN","SDEC07B",77,0) . S SDECFDA(2.98,SDECIENS,"15")="@" "RTN","SDEC07B",78,0) . S SDECFDA(2.98,SDECIENS,"16")="@" "RTN","SDEC07B",79,0) . S SDECFDA(2.98,SDECIENS,"17")="@" ;alb/sat 658 "RTN","SDEC07B",80,0) . S SDECFDA(2.98,SDECIENS,"19")=$$NULLDEL(DUZ) ;data entry clerk "RTN","SDEC07B",81,0) . S SDECFDA(2.98,SDECIENS,"20")=$$NOW^XLFDT "RTN","SDEC07B",82,0) . S SDECFDA(2.98,SDECIENS,"21")="@" ;outpatient encounter ;*zeb 722 2/26/19 clear to fix OE link issue if cancelled again "RTN","SDEC07B",83,0) . S SDECFDA(2.98,SDECIENS,"25")=$$NULLDEL(SDSRT) ;scheduling request type "RTN","SDEC07B",84,0) . S SDECFDA(2.98,SDECIENS,"26")=$$NULLDEL(SDNA) ;next ava. appt. indicator "RTN","SDEC07B",85,0) . S SDECFDA(2.98,SDECIENS,"27")=$$NULLDEL(BSDR("DDT")) ;desired date of appt "RTN","SDEC07B",86,0) . S SDECFDA(2.98,SDECIENS,"28")=$$NULLDEL(SDFU) ;follow-up visit yes/no "RTN","SDEC07B",87,0) . D FILE^DIE("","SDECFDA","SDECMSG") "RTN","SDEC07B",88,0) . N SDECTEMP S SDECTEMP=$$NULLDEL($G(SDECMSG)) "RTN","SDEC07B",89,0) E D I $G(SDECERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT") "RTN","SDEC07B",90,0) . ; add appt to file 2 "RTN","SDEC07B",91,0) . N SDECFDA,SDECIENS,SDECMSG "RTN","SDEC07B",92,0) . S SDECIENS="?+2,"_BSDR("PAT")_"," "RTN","SDEC07B",93,0) . S SDECIENS(2)=BSDR("ADT") "RTN","SDEC07B",94,0) . S SDECFDA(2.98,SDECIENS,.01)=BSDR("CLN") "RTN","SDEC07B",95,0) . S SDECFDA(2.98,SDECIENS,"3")=$S($G(^DPT(+$G(BSDR("PAT")),.1))'="":"I",1:"") "RTN","SDEC07B",96,0) . S SDECFDA(2.98,SDECIENS,"5")=BSDR("LAB") ;lab date/time "RTN","SDEC07B",97,0) . S SDECFDA(2.98,SDECIENS,"6")=BSDR("XRA") ;xray date/time "RTN","SDEC07B",98,0) . S SDECFDA(2.98,SDECIENS,"7")=BSDR("EKG") ;ekg date/time "RTN","SDEC07B",99,0) . S SDECFDA(2.98,SDECIENS,"9")=BSDR("TYP") "RTN","SDEC07B",100,0) . S:+BSDR("APT") SDECFDA(2.98,SDECIENS,"9.5")=BSDR("APT") "RTN","SDEC07B",101,0) . S:+BSDR("COL") SDECFDA(2.98,SDECIENS,"13")=BSDR("COL") "RTN","SDEC07B",102,0) . S SDECFDA(2.98,SDECIENS,"14")="" "RTN","SDEC07B",103,0) . S SDECFDA(2.98,SDECIENS,"15")="" "RTN","SDEC07B",104,0) . S SDECFDA(2.98,SDECIENS,"16")="" "RTN","SDEC07B",105,0) . S SDECFDA(2.98,SDECIENS,"17")="" ;alb/sat 658 "RTN","SDEC07B",106,0) . S SDECFDA(2.98,SDECIENS,"19")=DUZ ;data entry clerk "RTN","SDEC07B",107,0) . S SDECFDA(2.98,SDECIENS,"20")=$$NOW^XLFDT "RTN","SDEC07B",108,0) . S SDECFDA(2.98,SDECIENS,"25")=SDSRT ;scheduling request type "RTN","SDEC07B",109,0) . S SDECFDA(2.98,SDECIENS,"26")=SDNA ;next ava. appt. indicator "RTN","SDEC07B",110,0) . S SDECFDA(2.98,SDECIENS,"27")=BSDR("DDT") ;desired date of appt "RTN","SDEC07B",111,0) . S SDECFDA(2.98,SDECIENS,"28")=SDFU ;follow-up visit yes/no "RTN","SDEC07B",112,0) . D UPDATE^DIE("","SDECFDA","SDECIENS","SDECERR(1)") "RTN","SDEC07B",113,0) ; "RTN","SDEC07B",114,0) ; add appt to file 44 "RTN","SDEC07B",115,0) K DIC,DA,X,Y,DLAYGO,DD,DO "RTN","SDEC07B",116,0) I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^" "RTN","SDEC07B",117,0) I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT") "RTN","SDEC07B",118,0) . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT") "RTN","SDEC07B",119,0) . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001 "RTN","SDEC07B",120,0) . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN "RTN","SDEC07B",121,0) ; "RTN","SDEC07B",122,0) K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM "RTN","SDEC07B",123,0) S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," "RTN","SDEC07B",124,0) S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT") "RTN","SDEC07B",125,0) S DIC("DR")="1////"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7////"_BSDR("USR")_";8////"_$$NOW^XLFDT_";30////"_BSDR("ELG")_$S(+$G(BSDR("OVB")):";9////O",1:"") "RTN","SDEC07B",126,0) S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003 "RTN","SDEC07B",127,0) D FILE^DICN "RTN","SDEC07B",128,0) ;add consult link "RTN","SDEC07B",129,0) I $G(BSDR("CON")) D "RTN","SDEC07B",130,0) .N SDFDA,SDIEN "RTN","SDEC07B",131,0) .S SDIEN=+Y "RTN","SDEC07B",132,0) .Q:SDIEN=-1 "RTN","SDEC07B",133,0) .S SDFDA(44.003,SDIEN_","_BSDR("ADT")_","_BSDR("CLN")_",",688)=BSDR("CON") "RTN","SDEC07B",134,0) .D UPDATE^DIE("","SDFDA") "RTN","SDEC07B",135,0) ; "RTN","SDEC07B",136,0) Q 0 "RTN","SDEC07B",137,0) ; call event driver "RTN","SDEC07B",138,0) NEW DFN,SDT,SDCL,SDDA,SDMODE "RTN","SDEC07B",139,0) S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2 "RTN","SDEC07B",140,0) S SDDA=$$SCIEN^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) "RTN","SDEC07B",141,0) D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE) "RTN","SDEC07B",142,0) Q 0 "RTN","SDEC07B",143,0) ; "RTN","SDEC07B",144,0) NULLDEL(STR) ;return "@" to delete a field if the new data would be null ;*zeb+tag 722 2/19/19 added to support APPADD "RTN","SDEC07B",145,0) Q $S(STR]"":STR,1:"@") "RTN","SDEC07B",146,0) ; "RTN","SDEC07B",147,0) SDSRT(TYP,MTR,DDT,REQ) ;get SCHEDULING REQUEST TYPE and NEXT AVA.APPT. INDICATOR "RTN","SDEC07B",148,0) ;INPUT: "RTN","SDEC07B",149,0) ; TYP = 3 for scheduled appts, 4 for walkins "RTN","SDEC07B",150,0) ; MTR = MTRC flag (multiple appointments) 0=False (default) 1=True "RTN","SDEC07B",151,0) ; DDT = Desired Date of Appt in fm format "RTN","SDEC07B",152,0) ; REQ = Requested By - valid values are 1=PROVIDER 2=PATIENT or "" "RTN","SDEC07B",153,0) ;RETURN: 2 ^ pieces: "RTN","SDEC07B",154,0) ; 1 - SCHEDULING REQUEST TYPE internal format - valid values: "RTN","SDEC07B",155,0) ; N:'NEXT AVAILABLE' APPT. "RTN","SDEC07B",156,0) ; C:OTHER THAN 'NEXT AVA.' (CLINICIAN REQ.) "RTN","SDEC07B",157,0) ; P:OTHER THAN 'NEXT AVA.' (PATIENT REQ.) "RTN","SDEC07B",158,0) ; W:WALKIN APPT. "RTN","SDEC07B",159,0) ; M:MULTIPLE APPT. BOOKING "RTN","SDEC07B",160,0) ; A:AUTO REBOOK "RTN","SDEC07B",161,0) ; O:OTHER THAN 'NEXT AVA.' APPT. "RTN","SDEC07B",162,0) ; 2 - NEXT AVA. APPT. INDICATOR internal format - valid values: "RTN","SDEC07B",163,0) ; N:'NEXT AVAILABLE' APPT. "RTN","SDEC07B",164,0) ; C:OTHER THAN 'NEXT AVA.' (CLINICIAN REQ.) "RTN","SDEC07B",165,0) ; P:OTHER THAN 'NEXT AVA.' (PATIENT REQ.) "RTN","SDEC07B",166,0) ; W:WALKIN APPT. "RTN","SDEC07B",167,0) ; M:MULTIPLE APPT. BOOKING "RTN","SDEC07B",168,0) ; A:AUTO REBOOK "RTN","SDEC07B",169,0) ; O:OTHER THAN 'NEXT AVA.' APPT. "RTN","SDEC07B",170,0) ; "RTN","SDEC07B",171,0) N RET "RTN","SDEC07B",172,0) S RET="" "RTN","SDEC07B",173,0) ;1. If user creates a walkin appointment would be W:WALKIN APPT, 0:NOT INDICATED TO BE A 'NEXT AVA.' APPT "RTN","SDEC07B",174,0) I TYP=4 Q "W^0" "RTN","SDEC07B",175,0) ;2. If user creates an rm request with MTRC flagged "RTN","SDEC07B",176,0) ; AND desired date is 'today' "RTN","SDEC07B",177,0) ; would be M:MULTIPLE APPT. BOOKING, 3:'NEXT AVA.' APPT. INDICATED BY USER & CALCULATION "RTN","SDEC07B",178,0) I +MTR,$P($$NOW^XLFDT,".",1)=DDT Q "M^3" "RTN","SDEC07B",179,0) ;3. If user creates an rm request with MTRC flagged "RTN","SDEC07B",180,0) ; AND desired date is not 'today' "RTN","SDEC07B",181,0) ; would be M:MULTIPLE APPT. BOOKING, 0:'NOT INDICATED TO BE A 'NEXT AVA.' APPT "RTN","SDEC07B",182,0) I +MTR,$P($$NOW^XLFDT,".",1)'=DDT Q "M^0" "RTN","SDEC07B",183,0) ;4. If the user enters a desired date for the clinic stop that is today "RTN","SDEC07B",184,0) ; then N:'NEXT AVAILABLE' APPT., 1:'NEXT AVA.' APPT. INDICATED BY USER "RTN","SDEC07B",185,0) I $P($$NOW^XLFDT(),".",1)=DDT Q "N^1" "RTN","SDEC07B",186,0) ;5. If the user enters a desired date not today "RTN","SDEC07B",187,0) ; AND the request is by patient "RTN","SDEC07B",188,0) ; then P:OTHER THAN 'NEXT AVA.' (PATIENT REQ.); 0:NOT INDICATED TO BE A 'NEXT AVA.' APPT. "RTN","SDEC07B",189,0) I $P($$NOW^XLFDT(),".",1)'=DDT,REQ=2 Q "P^0" "RTN","SDEC07B",190,0) ;6. If the user enters a desired date not today "RTN","SDEC07B",191,0) ; AND the request is by provider "RTN","SDEC07B",192,0) ; then C:OTHER THAN 'NEXT AVA.' (CLINICIAN REQ.); 0:NOT INDICATED TO BE A 'NEXT AVA.' APPT. "RTN","SDEC07B",193,0) I $P($$NOW^XLFDT(),".",1)'=DDT,REQ=1 Q "C^0" "RTN","SDEC07B",194,0) Q RET "RTN","SDEC07B",195,0) ; "RTN","SDEC07B",196,0) ;Create Appointment ;alb/sat 665 moved from SDEC07 "RTN","SDEC07B",197,0) APPVISTA(SDECLEN,SDECNOTE,DFN,SDECRESD,SDECSTART,SDECWKIN,SDCL,SDECI) ; "RTN","SDEC07B",198,0) N SDECC,SDECERR,SDECRNOD "RTN","SDEC07B",199,0) S SDECRNOD=$G(^SDEC(409.831,SDECRESD,0)) "RTN","SDEC07B",200,0) I SDECRNOD="" D ERR^SDEC07(SDECI+1,"SDEC07 Error: Unable to add appointment -- invalid Resource entry.") Q 1 "RTN","SDEC07B",201,0) S SDECERR="" "RTN","SDEC07B",202,0) I +SDCL,$D(^SC(SDCL,0)) D I +SDECERR D ERR^SDEC07(SDECI+1,SDECERR) Q SDECERR "RTN","SDEC07B",203,0) . S SDECC("PAT")=DFN "RTN","SDEC07B",204,0) . S SDECC("CLN")=SDCL "RTN","SDEC07B",205,0) . S SDECC("TYP")=3 ;3 for scheduled appts, 4 for walkins "RTN","SDEC07B",206,0) . S:SDECWKIN SDECC("TYP")=4 "RTN","SDEC07B",207,0) . S SDECC("ADT")=SDECSTART "RTN","SDEC07B",208,0) . S SDECC("LEN")=SDECLEN "RTN","SDEC07B",209,0) . S SDECC("OI")=$E($G(SDECNOTE),1,150) ;File 44 has 150 character limit on OTHER field "RTN","SDEC07B",210,0) . S SDECC("OI")=$TR(SDECC("OI"),";"," ") ;No semicolons allowed "RTN","SDEC07B",211,0) . S SDECC("OI")=$$STRIP^SDEC07(SDECC("OI")) ;Strip control characters from note "RTN","SDEC07B",212,0) . S SDECC("RES")=SDECRESD "RTN","SDEC07B",213,0) . S SDECC("USR")=DUZ "RTN","SDEC07B",214,0) . S SDECERR=$$MAKE^SDEC07B(.SDECC) "RTN","SDEC07B",215,0) . Q:SDECERR "RTN","SDEC07B",216,0) . D AVUPDT^SDEC07(SDCL,SDECSTART,SDECLEN) "RTN","SDEC07B",217,0) . ;L "RTN","SDEC07B",218,0) . Q "RTN","SDEC07B",219,0) Q +SDECERR "RTN","SDEC08") 0^5^B210557907^B217036692 "RTN","SDEC08",1,0) SDEC08 ;ALB/SAT/JSM - VISTA SCHEDULING RPCS ;JUN 21, 2017 "RTN","SDEC08",2,0) ;;5.3;Scheduling;**627,651,658,665,722**;Aug 13, 1993;Build 26 "RTN","SDEC08",3,0) ; "RTN","SDEC08",4,0) Q "RTN","SDEC08",5,0) ; "RTN","SDEC08",6,0) APPDEL(SDECY,SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER) ;Cancels appointment "RTN","SDEC08",7,0) ;APPDEL(SDECY,SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER) external parameter tag is in SDEC "RTN","SDEC08",8,0) ;SDECAPTID - (required) pointer to SDEC APPOINTMENT file "RTN","SDEC08",9,0) ;SDECTYP - (required) appointment Status valid values: "RTN","SDEC08",10,0) ; C=CANCELLED BY CLINIC "RTN","SDEC08",11,0) ; PC=CANCELLED BY PATIENT "RTN","SDEC08",12,0) ;SDECCR - (optional) pointer to CANCELLATION REASON File (409.2) "RTN","SDEC08",13,0) ;SDECNOT - (optional) text representing user note "RTN","SDEC08",14,0) ;SDECDATE - (optional) Cancel Date/Time in external format; defaults to NOW "RTN","SDEC08",15,0) ;SDUSER - (optional) User that cancelled appt; defaults to current user "RTN","SDEC08",16,0) ;Returns error code in recordset field ERRORID "RTN","SDEC08",17,0) ; "RTN","SDEC08",18,0) N SDECNOD,SDECPATID,SDECSTART,DIK,DA,SDECID,SDECI,SDECZ,SDECERR "RTN","SDEC08",19,0) N SDECLOC,SDECLEN,SDECSCIEN,SDECSCIEN1 "RTN","SDEC08",20,0) N SDECNOEV,SDECSC1,SDRET "RTN","SDEC08",21,0) N %DT,X,Y "RTN","SDEC08",22,0) S SDECNOEV=1 ;Don't execute SDEC CANCEL APPOINTMENT protocol "RTN","SDEC08",23,0) S SDECSCIEN1=0 "RTN","SDEC08",24,0) ; "RTN","SDEC08",25,0) S SDECI=0 "RTN","SDEC08",26,0) S SDECY="^TMP(""SDEC08"","_$J_",""APPDEL"")" "RTN","SDEC08",27,0) K @SDECY "RTN","SDEC08",28,0) S @SDECY@(SDECI)="T00020ERRORID"_$C(30) "RTN","SDEC08",29,0) S SDECI=SDECI+1 "RTN","SDEC08",30,0) ;validate SDEC APPOINTMENT pointer (required) "RTN","SDEC08",31,0) I '$D(^SDEC(409.84,+$G(SDECAPTID),0)) D ERR(SDECI,"SDEC08: Invalid Appointment ID") Q "RTN","SDEC08",32,0) ;validate appointment status type (required) "RTN","SDEC08",33,0) S SDECTYP=$G(SDECTYP) "RTN","SDEC08",34,0) S SDECTYP=$S(SDECTYP="C":"C",SDECTYP="CANCELLED BY CLINIC":"C",SDECTYP="PC":"PC",SDECTYP="CANCELLED BY PATIENT":"PC",1:"") "RTN","SDEC08",35,0) I SDECTYP="" D ERR(SDECI,"SDEC08: Invalid status type") Q "RTN","SDEC08",36,0) ;validate CANCELLATION REASON pointer (optional) "RTN","SDEC08",37,0) S SDECCR=$G(SDECCR) "RTN","SDEC08",38,0) I SDECCR'="" I '$D(^SD(409.2,+SDECCR,0)) S SDECCR=$O(^SD(409.2,"B","SDECCR",0)) "RTN","SDEC08",39,0) ;validate SDECNOT "RTN","SDEC08",40,0) S SDECNOT=$TR(SDECNOT,"^"," ") ;alb/sat 658 - strip out ^ "RTN","SDEC08",41,0) ;validate cancel date/time "RTN","SDEC08",42,0) S SDECDATE=$G(SDECDATE) "RTN","SDEC08",43,0) I SDECDATE'="" S %DT="T" S X=SDECDATE D ^%DT S SDECDATE=Y I Y=-1 S SDECDATE="" "RTN","SDEC08",44,0) I $G(SDECDATE)="" S SDECDATE=$$NOW^XLFDT "RTN","SDEC08",45,0) ;validate user "RTN","SDEC08",46,0) S SDUSER=$G(SDUSER) "RTN","SDEC08",47,0) I SDUSER'="" I '$D(^VA(200,+SDUSER,0)) S SDUSER="" "RTN","SDEC08",48,0) I SDUSER="" S SDUSER=DUZ "RTN","SDEC08",49,0) ; "RTN","SDEC08",50,0) TSTART "RTN","SDEC08",51,0) ; "RTN","SDEC08",52,0) ;Delete APPOINTMENT entries "RTN","SDEC08",53,0) S SDECNOD=^SDEC(409.84,SDECAPTID,0) "RTN","SDEC08",54,0) S SDECPATID=$P(SDECNOD,U,5) "RTN","SDEC08",55,0) S SDECSTART=$P(SDECNOD,U) "RTN","SDEC08",56,0) ; "RTN","SDEC08",57,0) ;Lock SDEC node "RTN","SDEC08",58,0) L +^SDEC(409.84,SDECPATID):5 I '$T D ERR(SDECI+1,"Another user is working with this patient's record. Please try again later") TROLLBACK Q "RTN","SDEC08",59,0) ;cancel check-in if walk-in "RTN","SDEC08",60,0) I $P(SDECNOD,U,13)="y" D "RTN","SDEC08",61,0) .S SDRET="" "RTN","SDEC08",62,0) .D CHECKIN^SDEC25(.SDRET,SDECAPTID,"@") "RTN","SDEC08",63,0) ;cancel SDEC APPOINTMENT record "RTN","SDEC08",64,0) D SDECCAN(SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER,1) "RTN","SDEC08",65,0) ; "RTN","SDEC08",66,0) S SDECSC1=$P(SDECNOD,U,7) ;RESOURCEID "RTN","SDEC08",67,0) I SDECSC1]"",$D(^SDEC(409.831,SDECSC1,0)) D I +$G(SDECZ) S SDECERR=+SDECZ D ERR(SDECI,$P(SDECZ,U,2)) Q "RTN","SDEC08",68,0) . S SDECNOD=^SDEC(409.831,SDECSC1,0) "RTN","SDEC08",69,0) . S SDECLOC=$P(SDECNOD,U,4) ;HOSPITAL LOCATION "RTN","SDEC08",70,0) . Q:'+SDECLOC "RTN","SDEC08",71,0) . S SDECSCIEN=$$SCIEN^SDECU2(SDECPATID,SDECLOC,SDECSTART) I SDECSCIEN="" D I 'SDECZ Q ;Q:SDECZ "RTN","SDEC08",72,0) . . S SDECERR="SDEC08: Unable to find associated appointment for this patient. " "RTN","SDEC08",73,0) . . S SDECZ=1 "RTN","SDEC08",74,0) . . I '$D(^SDEC(409.831,SDECSC1,20)) S SDECZ=0 Q "RTN","SDEC08",75,0) . . N SDEC1 "RTN","SDEC08",76,0) . . S SDEC1=0 "RTN","SDEC08",77,0) . . F S SDEC1=$O(^SDEC(409.831,SDECSC1,20,SDEC1)) Q:'+SDEC1 Q:SDECZ=0 D "RTN","SDEC08",78,0) . . . Q:'$D(^SDEC(409.831,SDECSC1,20,SDEC1,0)) "RTN","SDEC08",79,0) . . . S SDECLOC=$P(^SDEC(409.831,SDECSC1,20,SDEC1,0),U) "RTN","SDEC08",80,0) . . . S SDECSCIEN=$$SCIEN^SDECU2(SDECPATID,SDECLOC,SDECSTART) I +SDECSCIEN S SDECZ=0 Q "RTN","SDEC08",81,0) . S SDECERR="SDEC08: CANCEL^SDEC08 Returned " "RTN","SDEC08",82,0) . I SDECLOC']"" S SDECZ="0^Unable to find associated appointment for this patient." Q "RTN","SDEC08",83,0) . I '$D(^SC(SDECLOC,0)) S SDECZ="0^Unable to find associated appointment for this patient." Q "RTN","SDEC08",84,0) . S SDECNOD=$G(^SC(SDECLOC,"S",SDECSTART,1,+SDECSCIEN,0)) "RTN","SDEC08",85,0) . I SDECNOD="" S SDECZ="0^Unable to find associated appointment for this patient." Q "RTN","SDEC08",86,0) . S SDECLEN=$P(SDECNOD,U,2) "RTN","SDEC08",87,0) . D APCAN(.SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECAPTID,SDECLEN) "RTN","SDEC08",88,0) . Q:+$G(SDECZ) "RTN","SDEC08",89,0) . D AVUPDT(SDECLOC,SDECSTART,SDECLEN) "RTN","SDEC08",90,0) . D AR433D^SDECAR2(SDECAPTID) "RTN","SDEC08",91,0) . ;L "RTN","SDEC08",92,0) ; "RTN","SDEC08",93,0) TCOMMIT "RTN","SDEC08",94,0) L -^SDEC(409.84,SDECPATID) "RTN","SDEC08",95,0) S SDECI=SDECI+1 "RTN","SDEC08",96,0) S @SDECY@(SDECI)=""_$C(30) "RTN","SDEC08",97,0) S SDECI=SDECI+1 "RTN","SDEC08",98,0) S @SDECY@(SDECI)=$C(31) "RTN","SDEC08",99,0) Q "RTN","SDEC08",100,0) ; "RTN","SDEC08",101,0) AVUPDT(SDECSCD,SDECSTART,SDECLEN) ;Update Clinic availability "RTN","SDEC08",102,0) ;See SDCNP0 "RTN","SDEC08",103,0) N HSI,I,S,SB,SD,SDDIF,SI,SL,SS,ST,STARTDAY,STR,X,Y "RTN","SDEC08",104,0) S (SD,S)=SDECSTART "RTN","SDEC08",105,0) S I=SDECSCD "RTN","SDEC08",106,0) Q:'$D(^SC(I,"ST",SD\1,1)) "RTN","SDEC08",107,0) S SL=^SC(I,"SL"),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) "RTN","SDEC08",108,0) S SL=SDECLEN "RTN","SDEC08",109,0) S S=^SC(I,"ST",SD\1,1),Y=SD#1-SB*100,ST=Y#1*SI\.6+(Y\1*SI),SS=SL*HSI/60 "RTN","SDEC08",110,0) I Y'<1 F I=ST+ST:SDDIF S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y="" S S=$E(S,1,I)_Y_$E(S,I+2,999),SS=SS-1 Q:SS'>0 "RTN","SDEC08",111,0) S ^SC(SDECSCD,"ST",SD\1,1)=S "RTN","SDEC08",112,0) Q "RTN","SDEC08",113,0) ; "RTN","SDEC08",114,0) APCAN(SDECZ,SDECLOC,SDECDFN,SDECSD,SDECAPTID,SDECLEN) ; "RTN","SDEC08",115,0) ;Cancel appointment for patient SDECDFN in clinic SDECSC1 "RTN","SDEC08",116,0) ;at time SDECSD "RTN","SDEC08",117,0) N SDECPNOD,SDECC,DA,DIE,DPTST,DR,%H "RTN","SDEC08",118,0) ;save data into SDEC APPOINTMENT in case of un-cancel (status & appt length) "RTN","SDEC08",119,0) S SDECPNOD=^DPT(SDECPATID,"S",SDECSD,0) "RTN","SDEC08",120,0) S DPTST=$P(SDECPNOD,U,2) "RTN","SDEC08",121,0) S DIE=409.84 "RTN","SDEC08",122,0) S DA=SDECAPTID "RTN","SDEC08",123,0) S DR=".17///"_DPTST_";"_".18///"_SDECLEN "RTN","SDEC08",124,0) D ^DIE "RTN","SDEC08",125,0) S SDECC("PAT")=SDECDFN "RTN","SDEC08",126,0) S SDECC("CLN")=SDECLOC "RTN","SDEC08",127,0) S SDECC("TYP")=SDECTYP "RTN","SDEC08",128,0) S SDECC("ADT")=SDECSD "RTN","SDEC08",129,0) S %H=$H D YMD^%DTC "RTN","SDEC08",130,0) S SDECC("CDT")=SDECDATE ;X+% "RTN","SDEC08",131,0) S SDECC("NOT")=SDECNOT "RTN","SDEC08",132,0) S:+SDECCR SDECC("CR")=SDECCR "RTN","SDEC08",133,0) S SDECC("USR")=SDUSER "RTN","SDEC08",134,0) ; "RTN","SDEC08",135,0) S SDECZ=$$CANCEL(.SDECC) "RTN","SDEC08",136,0) Q "RTN","SDEC08",137,0) ; "RTN","SDEC08",138,0) SDECCAN(SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER,SDF) ;cancel SDEC APPOINTMENT entry "RTN","SDEC08",139,0) ;SDECAPTID - (required) pointer to SDEC APPOINTMENT file "RTN","SDEC08",140,0) ;SDECTYP - (required) appointment Status valid values: "RTN","SDEC08",141,0) ; C=CANCELLED BY CLINIC "RTN","SDEC08",142,0) ; PC=CANCELLED BY PATIENT "RTN","SDEC08",143,0) ;SDECCR - (optional) pointer to CANCELLATION REASON File (409.2) "RTN","SDEC08",144,0) ;SDECNOT - (optional) text representing user note "RTN","SDEC08",145,0) ;SDECDATE - (optional) Cancel Date/Time in fm format; defaults to NOW) ; "RTN","SDEC08",146,0) ;SDF - (optional) flags "RTN","SDEC08",147,0) ; 1. called from GUI (update consult only if called from GUI) "RTN","SDEC08",148,0) ; 2. called from cancel in SDAM (CAN^SDCNP0) (do not reopen appt) "RTN","SDEC08",149,0) ;Cancel SDEC APPOINTMENT entry "RTN","SDEC08",150,0) N DFN,PROVIEN,Y "RTN","SDEC08",151,0) N SAVESTRT,SDAPTYP,SDCL,SDI,SDIEN,SDECIENS,SDECFDA,SDECMSG,SDECWP,SDRES,SDT ;alb/sat 651 add SAVESTRT and SDRES "RTN","SDEC08",152,0) S SDF=$G(SDF,0) "RTN","SDEC08",153,0) S DFN=$$GET1^DIQ(409.84,SDECAPTID_",",.05) ;alb/sat 658 "RTN","SDEC08",154,0) S SDT=$$GET1^DIQ(409.84,SDECAPTID_",",.01,"I") "RTN","SDEC08",155,0) S SAVESTRT=$$GET1^DIQ(409.84,SDECAPTID_",",.01) ;alb/sat 651 "RTN","SDEC08",156,0) S SDRES=$$GET1^DIQ(409.84,SDECAPTID_",",.07,"I") ;alb/sat 651 "RTN","SDEC08",157,0) S SDECIENS=SDECAPTID_"," "RTN","SDEC08",158,0) S SDECFDA(409.84,SDECIENS,.12)=$S($G(SDECDATE)'="":SDECDATE,1:$$NOW^XLFDT) "RTN","SDEC08",159,0) S SDECFDA(409.84,SDECIENS,.121)=$S($G(SDUSER)'="":SDUSER,1:DUZ) "RTN","SDEC08",160,0) S:$G(SDECCR)'="" SDECFDA(409.84,SDECIENS,.122)=SDECCR "RTN","SDEC08",161,0) S SDECFDA(409.84,SDECIENS,.17)=SDECTYP "RTN","SDEC08",162,0) K SDECMSG "RTN","SDEC08",163,0) D FILE^DIE("","SDECFDA","SDECMSG") "RTN","SDEC08",164,0) S SDAPTYP=$$GET1^DIQ(409.84,SDECAPTID_",",.22,"I") "RTN","SDEC08",165,0) ;alb/sat 658 modification begin "RTN","SDEC08",166,0) S SDECNOT=$G(SDECNOT),SDECNOT=$E(SDECNOT,1,160) "RTN","SDEC08",167,0) I $L(SDECNOT)>2,'$E(SDF,2) K SDECFDA S SDECFDA(2.98,SDT_","_DFN_",",17)=SDECNOT D UPDATE^DIE("","SDECFDA") "RTN","SDEC08",168,0) ;alb/sat 658 modification end "RTN","SDEC08",169,0) I $P(SDAPTYP,";",2)="GMR(123,",$E(SDF,1) D "RTN","SDEC08",170,0) .S SDCL=$$SDCL^SDECUTL(SDECAPTID) "RTN","SDEC08",171,0) .S PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I") "RTN","SDEC08",172,0) .D REQSET^SDEC07A($P(SDAPTYP,";",1),PROVIEN,"",2,SDECTYP,SDECNOT,SAVESTRT,SDRES) ;alb/sat 651 added SAVESTRT "RTN","SDEC08",173,0) I $P(SDAPTYP,";",2)="SDWL(409.3," D ;update EWL "RTN","SDEC08",174,0) .S DFN=$$GET1^DIQ(409.3,$P(SDAPTYP,";",1)_",",.01,"I") "RTN","SDEC08",175,0) .Q:DFN="" "RTN","SDEC08",176,0) .S SDIEN=0 F S SDIEN=$O(^SDWL(409.3,"B",DFN,SDIEN)) Q:SDIEN="" D "RTN","SDEC08",177,0) ..I $$GET1^DIQ(409.3,SDIEN_",",13,"I")=SDT D "RTN","SDEC08",178,0) ...K SDECFDA,SDECMSG,SDECWP "RTN","SDEC08",179,0) ...;S SDIEN=$P(SDAPTYP,";",1) "RTN","SDEC08",180,0) ...S SDECFDA(409.3,SDIEN_",",13)="@" "RTN","SDEC08",181,0) ...S SDECFDA(409.3,SDIEN_",",13.1)="@" "RTN","SDEC08",182,0) ...S SDECFDA(409.3,SDIEN_",",13.2)="@" "RTN","SDEC08",183,0) ...S SDECFDA(409.3,SDIEN_",",13.3)="@" "RTN","SDEC08",184,0) ...S SDECFDA(409.3,SDIEN_",",13.4)="@" "RTN","SDEC08",185,0) ...S SDECFDA(409.3,SDIEN_",",13.5)="@" "RTN","SDEC08",186,0) ...S SDECFDA(409.3,SDIEN_",",13.6)="@" "RTN","SDEC08",187,0) ...S SDECFDA(409.3,SDIEN_",",13.7)="@" "RTN","SDEC08",188,0) ...S SDECFDA(409.3,SDIEN_",",13.8)="@" "RTN","SDEC08",189,0) ...D UPDATE^DIE("","SDECFDA") "RTN","SDEC08",190,0) ...D:'$E(SDF,2) WLOPEN^SDECWL("","",SDIEN) ;alb/jsm 658 do not reopen if called from SDEC^SDCNP0 "RTN","SDEC08",191,0) I $P(SDAPTYP,";",2)="SDEC(409.85," D ;update APPT "RTN","SDEC08",192,0) .K SDECFDA,SDECMSG,SDECWP "RTN","SDEC08",193,0) .D:'$E(SDF,2) AROPEN^SDECAR("",SDECAPTID) ;alb/jsm 658 do not reopen if called from SDEC^SDCNP0 "RTN","SDEC08",194,0) .S SDIEN=$P(SDAPTYP,";",1) "RTN","SDEC08",195,0) .S SDECFDA(409.85,SDIEN_",",13)="@" "RTN","SDEC08",196,0) .S SDECFDA(409.85,SDIEN_",",13.1)="@" "RTN","SDEC08",197,0) .S SDECFDA(409.85,SDIEN_",",13.2)="@" "RTN","SDEC08",198,0) .S SDECFDA(409.85,SDIEN_",",13.3)="@" "RTN","SDEC08",199,0) .S SDECFDA(409.85,SDIEN_",",13.4)="@" "RTN","SDEC08",200,0) .S SDECFDA(409.85,SDIEN_",",13.5)="@" "RTN","SDEC08",201,0) .S SDECFDA(409.85,SDIEN_",",13.6)="@" "RTN","SDEC08",202,0) .S SDECFDA(409.85,SDIEN_",",13.7)="@" "RTN","SDEC08",203,0) .S SDECFDA(409.85,SDIEN_",",13.8)="@" "RTN","SDEC08",204,0) .D UPDATE^DIE("","SDECFDA") "RTN","SDEC08",205,0) Q "RTN","SDEC08",206,0) ; "RTN","SDEC08",207,0) CANEVT(SDECPAT,SDECSTART,SDECSC) ;EP Called by SDEC CANCEL APPOINTMENT event "RTN","SDEC08",208,0) ;when appointments cancelled via PIMS interface. "RTN","SDEC08",209,0) ;Propagates cancellation to SDECAPPT and raises refresh event to running GUI clients "RTN","SDEC08",210,0) N SDECFOUND,SDECRES "RTN","SDEC08",211,0) Q:+$G(SDECNOEV) "RTN","SDEC08",212,0) Q:'+$G(SDECSC) "RTN","SDEC08",213,0) S SDECFOUND=0 "RTN","SDEC08",214,0) I $D(^SDEC(409.831,"ALOC",SDECSC)) S SDECRES=$O(^SDEC(409.831,"ALOC",SDECSC,0)) S SDECFOUND=$$CANEVT1(SDECRES,SDECSTART,SDECPAT) "RTN","SDEC08",215,0) I SDECFOUND D CANEVT3(SDECRES) Q "RTN","SDEC08",216,0) Q "RTN","SDEC08",217,0) ; "RTN","SDEC08",218,0) CANEVT1(SDECRES,SDECSTART,SDECPAT) ; "RTN","SDEC08",219,0) ;Get appointment id in SDECAPT "RTN","SDEC08",220,0) ;If found, call SDECCAN(SDECAPPT) and return 1 "RTN","SDEC08",221,0) ;else return 0 "RTN","SDEC08",222,0) N SDECFOUND,SDECAPPT "RTN","SDEC08",223,0) S SDECFOUND=0 "RTN","SDEC08",224,0) Q:'+SDECRES SDECFOUND "RTN","SDEC08",225,0) Q:'$D(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART)) SDECFOUND "RTN","SDEC08",226,0) S SDECAPPT=0 F S SDECAPPT=$O(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART,SDECAPPT)) Q:'+SDECAPPT D Q:SDECFOUND "RTN","SDEC08",227,0) . S SDECNOD=$G(^SDEC(409.84,SDECAPPT,0)) Q:SDECNOD="" "RTN","SDEC08",228,0) . I $P(SDECNOD,U,5)=SDECPAT,$P(SDECNOD,U,12)="" S SDECFOUND=1 Q "RTN","SDEC08",229,0) I SDECFOUND,+$G(SDECAPPT) D SDECCAN(SDECAPPT,,,,,,1) "RTN","SDEC08",230,0) Q SDECFOUND "RTN","SDEC08",231,0) ; "RTN","SDEC08",232,0) CANEVT3(SDECRES) ; "RTN","SDEC08",233,0) ;Call RaiseEvent to notify GUI clients "RTN","SDEC08",234,0) ; "RTN","SDEC08",235,0) Q "RTN","SDEC08",236,0) N SDECRESN "RTN","SDEC08",237,0) S SDECRESN=$G(^SDEC(409.831,SDECRES,0)) "RTN","SDEC08",238,0) Q:SDECRESN="" "RTN","SDEC08",239,0) S SDECRESN=$P(SDECRESN,"^") "RTN","SDEC08",240,0) ;D EVENT^SDEC23("SCHEDULE-"_SDECRESN,"","","") "RTN","SDEC08",241,0) ;D EVENT^BMXMEVN("SDEC SCHEDULE",SDECRESN) "RTN","SDEC08",242,0) Q "RTN","SDEC08",243,0) ; "RTN","SDEC08",244,0) CANCEL(BSDR) ;EP; called to cancel appt "RTN","SDEC08",245,0) ; "RTN","SDEC08",246,0) ; Make call using: S ERR=$$CANCEL^SDEC08(.ARRAY) "RTN","SDEC08",247,0) ; "RTN","SDEC08",248,0) ; Input Array - "RTN","SDEC08",249,0) ; BSDR("PAT") = ien of patient in file 2 "RTN","SDEC08",250,0) ; BSDR("CLN") = ien of clinic in file 44 "RTN","SDEC08",251,0) ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled "RTN","SDEC08",252,0) ; BSDR("ADT") = appointment date and time "RTN","SDEC08",253,0) ; BSDR("CDT") = cancel date and time "RTN","SDEC08",254,0) ; BSDR("USR") = user who canceled appt "RTN","SDEC08",255,0) ; BSDR("CR") = cancel reason - pointer to file 409.2 "RTN","SDEC08",256,0) ; BSDR("NOT") = cancel remarks - optional notes to 160 characters "RTN","SDEC08",257,0) ; "RTN","SDEC08",258,0) ;Output: error status and message "RTN","SDEC08",259,0) ; = 0 or null: everything okay "RTN","SDEC08",260,0) ; = 1^message: error and reason "RTN","SDEC08",261,0) ; "RTN","SDEC08",262,0) I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) "RTN","SDEC08",263,0) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) "RTN","SDEC08",264,0) I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP")) "RTN","SDEC08",265,0) I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds "RTN","SDEC08",266,0) I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) "RTN","SDEC08",267,0) I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds "RTN","SDEC08",268,0) I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT")) "RTN","SDEC08",269,0) I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR")) "RTN","SDEC08",270,0) I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR")) "RTN","SDEC08",271,0) ; "RTN","SDEC08",272,0) NEW IEN,DIE,DA,DR,SDMODE,HLAPTIEN ;*zeb+1 722 2/21/19 save IEN for canceling appt "RTN","SDEC08",273,0) S IEN=$$SCIEN^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")),HLAPTIEN=IEN "RTN","SDEC08",274,0) I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") "RTN","SDEC08",275,0) ; "RTN","SDEC08",276,0) I $$CI^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until check-in deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") "RTN","SDEC08",277,0) ; "RTN","SDEC08",278,0) ; remember before status "RTN","SDEC08",279,0) NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL "RTN","SDEC08",280,0) S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN "RTN","SDEC08",281,0) S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL "RTN","SDEC08",282,0) D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL) "RTN","SDEC08",283,0) ; "RTN","SDEC08",284,0) ; get user who made appt and date appt made from ^SC "RTN","SDEC08",285,0) ; because data in ^SC will be deleted "RTN","SDEC08",286,0) NEW USER,DATE "RTN","SDEC08",287,0) S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6) "RTN","SDEC08",288,0) S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7) "RTN","SDEC08",289,0) ; "RTN","SDEC08",290,0) ; update file 2 info "RTN","SDEC08",291,0) NEW DIE,DA,DR "RTN","SDEC08",292,0) N SDFDA,SDIEN,SDMSG "RTN","SDEC08",293,0) S SDFDA="SDFDA(2.98,SDT_"",""_DFN_"","")" "RTN","SDEC08",294,0) S @SDFDA@(3)=BSDR("TYP") "RTN","SDEC08",295,0) S @SDFDA@(14)=BSDR("USR") "RTN","SDEC08",296,0) S @SDFDA@(15)=BSDR("CDT") "RTN","SDEC08",297,0) S:+$G(BSDR("CR")) @SDFDA@(16)=BSDR("CR") "RTN","SDEC08",298,0) S:$G(BSDR("NOT"))]"" @SDFDA@(17)=$E(BSDR("NOT"),1,160) "RTN","SDEC08",299,0) S @SDFDA@(19)=USER "RTN","SDEC08",300,0) S @SDFDA@(20)=DATE "RTN","SDEC08",301,0) D UPDATE^DIE("","SDFDA") "RTN","SDEC08",302,0) N SDPCE "RTN","SDEC08",303,0) S SDPCE=$P($G(^DPT(DFN,"S",SDT,0)),U,20) "RTN","SDEC08",304,0) D:+SDPCE EN^SDCODEL(SDPCE,0) ;remove OUTPATIENT ENCOUNTER link "RTN","SDEC08",305,0) ; "RTN","SDEC08",306,0) ; cancel appointment in ^SC "RTN","SDEC08",307,0) ;NEW DIK,DA ;*zeb+4 722 2/21/19 mark as canceled instead of (failing to) delete so expand entry works correctly "RTN","SDEC08",308,0) ;S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," "RTN","SDEC08",309,0) ;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN "RTN","SDEC08",310,0) ;D ^DIK "RTN","SDEC08",311,0) S $P(^SC(BSDR("CLN"),"S",BSDR("ADT"),1,HLAPTIEN,0),"^",9)="C" "RTN","SDEC08",312,0) ; call event driver "RTN","SDEC08",313,0) S SDATA=SDDA_U_DFN_U_SDT_U_SDCL "RTN","SDEC08",314,0) ;D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL) "RTN","SDEC08",315,0) Q 0 "RTN","SDEC08",316,0) ; "RTN","SDEC08",317,0) UNDOCANA(SDECY,SDECAPTID) ;Undo Cancel Appointment "RTN","SDEC08",318,0) ;UNDOCANA(SDECY,SDECAPTID) external parameter tag in SDEC "RTN","SDEC08",319,0) ;called by SDEC UNCANCEL APPT "RTN","SDEC08",320,0) ; SDECAPTID = ien of appointment in SDEC APPOINTMENT (^SDECAPPT) file 409.84 "RTN","SDEC08",321,0) N SDECDAM,SDECDEC,SDECI,SDECNOD,SDECPATID,SDECSTART "RTN","SDEC08",322,0) S SDECNOEV=1 ;Don't execute SDEC CANCEL APPOINTMENT protocol ;is this used? "RTN","SDEC08",323,0) ; "RTN","SDEC08",324,0) S SDECI=0 "RTN","SDEC08",325,0) K ^TMP("SDEC",$J) "RTN","SDEC08",326,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDEC08",327,0) S ^TMP("SDEC",$J,SDECI)="T00020ERRORID"_$C(30) "RTN","SDEC08",328,0) TSTART "RTN","SDEC08",329,0) I '+SDECAPTID TROLLBACK D ERR(SDECI+1,"Invalid Appointment ID.") Q "RTN","SDEC08",330,0) I '$D(^SDEC(409.84,SDECAPTID,0)) TROLLBACK D ERR(SDECI+1,"Invalid Appointment ID") Q "RTN","SDEC08",331,0) ;Make sure appointment is cancelled "RTN","SDEC08",332,0) I $$GET1^DIQ(409.84,SDECAPTID_",",.12)="" TROLLBACK D ERR(SDECI+1,"Appointment is not Cancelled.") Q "RTN","SDEC08",333,0) S SDECNOD=^SDEC(409.84,SDECAPTID,0) "RTN","SDEC08",334,0) ;appts cancelled by patient cannot be un-cancelled. /* removed 9/17/2010 */ "RTN","SDEC08",335,0) ;I $P(^DPT($P(SDECNOD,U,5),"S",$P(SDECNOD,U,1),0),U,2)="PC" TROLLBACK D ERR(SDECI+1,"Cancelled by patient appointment cannot be uncancelled.") Q "RTN","SDEC08",336,0) ;get appointment data "RTN","SDEC08",337,0) S SDECNOD=^SDEC(409.84,SDECAPTID,0) "RTN","SDEC08",338,0) S SDECDAM=$P(SDECNOD,U,9) ;date appt made "RTN","SDEC08",339,0) S SDECDEC=$P(SDECNOD,U,8) ;data entry clerk "RTN","SDEC08",340,0) S SDECLEN=$P(SDECNOD,U,18) ;length of appt in minutes "RTN","SDEC08",341,0) S SDECNOTE=$G(^SDEC(409.84,SDECAPTID,1,1,0)) ;note from SDEC APPOINTMENT "RTN","SDEC08",342,0) S SDECPATID=$P(SDECNOD,U,5) ;pointer to VA PATIENT file 2 "RTN","SDEC08",343,0) S SDECSC1=$P($G(SDECNOD),U,7) ;resource "RTN","SDEC08",344,0) S SDECSTART=$P(SDECNOD,U) ;appt start time "RTN","SDEC08",345,0) S SDECWKIN=$P($G(SDECNOD),U,13) ;walk-in "RTN","SDEC08",346,0) ;lock SDEC node "RTN","SDEC08",347,0) L +^SDEC(409.84,SDECPATID):5 I '$T D ERR(SDECI+1,"Another user is working with this patient's record. Please try again later") TROLLBACK Q "RTN","SDEC08",348,0) ;un-cancel SDEC APPOINTMENT "RTN","SDEC08",349,0) D SDECUCAN(SDECAPTID) "RTN","SDEC08",350,0) I SDECSC1]"",$D(^SDEC(409.831,SDECSC1,0)) D I +$G(SDECZ) S SDECERR=SDECERR_$P(SDECZ,U,2) D ERR(SDECI,SDECERR) Q "RTN","SDEC08",351,0) . S SDECLOC="" "RTN","SDEC08",352,0) . S SDECNOD=^SDEC(409.831,SDECSC1,0) "RTN","SDEC08",353,0) . S SDECLOC=$P(SDECNOD,U,4) ;HOSPITAL LOCATION ;support for single HOSPITAL LOCATION in SDEC RESOURCE "RTN","SDEC08",354,0) . I SDECLOC="" S SDECLOC=$$SDCL^SDECUTL(SDECAPTID) ;HOSPITAL LOCATION "RTN","SDEC08",355,0) . Q:'+SDECLOC "RTN","SDEC08",356,0) . ;un-cancel patient appointment and re-instate clinic appointment "RTN","SDEC08",357,0) . S SDECZ="" "RTN","SDEC08",358,0) . D APUCAN(.SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECDAM,SDECDEC,SDECLEN,SDECNOTE,SDECSC1,SDECWKIN) "RTN","SDEC08",359,0) TCOMMIT "RTN","SDEC08",360,0) L -^SDEC(409.84,SDECPATID) "RTN","SDEC08",361,0) S SDECI=SDECI+1 "RTN","SDEC08",362,0) S ^TMP("SDEC",$J,SDECI)=""_$C(30) "RTN","SDEC08",363,0) S SDECI=SDECI+1 "RTN","SDEC08",364,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC08",365,0) Q "RTN","SDEC08",366,0) ; "RTN","SDEC08",367,0) SDECUCAN(SDECAPTID) ;called internally to update SDEC APPOINTMENT by clearing cancel date/time "RTN","SDEC08",368,0) N PROVIEN,SDAPTYP,SDCL,SDRES "RTN","SDEC08",369,0) S SDECIENS=SDECAPTID_"," "RTN","SDEC08",370,0) S SDECFDA(409.84,SDECIENS,.12)="" "RTN","SDEC08",371,0) K SDECMSG "RTN","SDEC08",372,0) D FILE^DIE("","SDECFDA","SDECMSG") "RTN","SDEC08",373,0) S SDAPTYP=$$GET1^DIQ(409.84,SDECAPTID_",",.22,"I") "RTN","SDEC08",374,0) I $P(SDAPTYP,";",2)="GMR(123," D "RTN","SDEC08",375,0) .S SDCL=$$SDCL^SDECUTL(SDECAPTID) "RTN","SDEC08",376,0) .S PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I") "RTN","SDEC08",377,0) .D REQSET^SDEC07A($P(SDAPTYP,";",1),PROVIEN,"",1) "RTN","SDEC08",378,0) Q "RTN","SDEC08",379,0) ; "RTN","SDEC08",380,0) APUCAN(SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECDAM,SDECDEC,SDECLEN,SDECNOTE,SDECRES,SDECWKIN) ; "RTN","SDEC08",381,0) ;un-Cancel appointment for patient SDECDFN in clinic SDECSC1 "RTN","SDEC08",382,0) ; SDECLOC = pointer to hospital location ^SC file 44 "RTN","SDEC08",383,0) ; SDECPATID = pointer to VA Patient ^DPT file 2 "RTN","SDEC08",384,0) ; SDECSTART = Appointment time "RTN","SDEC08",385,0) ; SDECDAM = Date appointment made in FM format "RTN","SDEC08",386,0) ; SDECDEC = Data entry clerk - pointer to NEW PERSON file 200 "RTN","SDEC08",387,0) N SDECC,%H "RTN","SDEC08",388,0) S SDECC("PAT")=SDECPATID "RTN","SDEC08",389,0) S SDECC("CLN")=SDECLOC "RTN","SDEC08",390,0) S SDECC("ADT")=SDECSTART "RTN","SDEC08",391,0) S SDECC("NOTE")=SDECNOTE ;user note "RTN","SDEC08",392,0) S SDECC("RES")=SDECRES "RTN","SDEC08",393,0) S SDECC("USR")=DUZ "RTN","SDEC08",394,0) S SDECC("LEN")=SDECLEN "RTN","SDEC08",395,0) S SDECC("WKIN")=SDECWKIN "RTN","SDEC08",396,0) ; "RTN","SDEC08",397,0) S SDECZ=$$UNCANCEL(.SDECC) "RTN","SDEC08",398,0) Q "RTN","SDEC08",399,0) ; "RTN","SDEC08",400,0) UNCANCEL(BSDR) ;PEP; called to un-cancel appt "RTN","SDEC08",401,0) ; "RTN","SDEC08",402,0) ; Make call using: S ERR=$$UNCANCEL(.ARRAY) "RTN","SDEC08",403,0) ; "RTN","SDEC08",404,0) ; Input Array - "RTN","SDEC08",405,0) ; BSDR("PAT") = ien of patient in file 2 "RTN","SDEC08",406,0) ; BSDR("CLN") = ien of clinic in file 44 "RTN","SDEC08",407,0) ; BSDR("ADT") = appointment date and time "RTN","SDEC08",408,0) ; BSDR("USR") = user who un-canceled appt "RTN","SDEC08",409,0) ; BSDR("NOTE") = appointment note from SDEC APPOINTMENT "RTN","SDEC08",410,0) ; BSDR("LEN") = appt length in minutes (numeric) "RTN","SDEC08",411,0) ; BSDR("RES") = resource "RTN","SDEC08",412,0) ; BSDR("WKIN")= walk-in "RTN","SDEC08",413,0) ; "RTN","SDEC08",414,0) ;Output: error status and message "RTN","SDEC08",415,0) ; = 0 or null: everything okay "RTN","SDEC08",416,0) ; = 1^message: error and reason "RTN","SDEC08",417,0) ; "RTN","SDEC08",418,0) N DPTNOD,DPTNODR "RTN","SDEC08",419,0) I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) "RTN","SDEC08",420,0) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) "RTN","SDEC08",421,0) I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds "RTN","SDEC08",422,0) I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) "RTN","SDEC08",423,0) I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR")) "RTN","SDEC08",424,0) ; "RTN","SDEC08",425,0) S SDECERR=$$APPVISTA^SDEC07B(BSDR("LEN"),BSDR("NOTE"),BSDR("PAT"),BSDR("RES"),BSDR("ADT"),BSDR("WKIN"),BSDR("CLN"),.SDECI) ;alb/sat 665 APPVISTA moved to SDEC07B "RTN","SDEC08",426,0) Q SDECERR "RTN","SDEC08",427,0) ; "RTN","SDEC08",428,0) ERR(SDECI,SDECERR) ;Error processing "RTN","SDEC08",429,0) S SDECI=SDECI+1 "RTN","SDEC08",430,0) S SDECERR=$TR(SDECERR,"^","~") "RTN","SDEC08",431,0) TROLLBACK "RTN","SDEC08",432,0) S ^TMP("SDEC",$J,SDECI)=SDECERR_$C(30) "RTN","SDEC08",433,0) S SDECI=SDECI+1 "RTN","SDEC08",434,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC08",435,0) Q "RTN","SDEC08",436,0) ; "RTN","SDEC08",437,0) ETRAP ;EP Error trap entry "RTN","SDEC08",438,0) D ^%ZTER "RTN","SDEC08",439,0) I '$D(SDECI) N SDECI S SDECI=999999 "RTN","SDEC08",440,0) S SDECI=SDECI+1 "RTN","SDEC08",441,0) D ERR(SDECI,"SDEC08 Error") "RTN","SDEC08",442,0) Q "RTN","SDEC26") 0^6^B17286312^B15946491 "RTN","SDEC26",1,0) SDEC26 ;ALB/SAT - VISTA SCHEDULING RPCS ;MAR 15, 2017 "RTN","SDEC26",2,0) ;;5.3;Scheduling;**627,658,722**;Aug 13, 1993;Build 26 "RTN","SDEC26",3,0) ; "RTN","SDEC26",4,0) Q "RTN","SDEC26",5,0) ; "RTN","SDEC26",6,0) EDITAPPT(SDECY,SDECAPTID,SDECNOTE,SDECLEN) ;Edit appointment (only 'note text' and appointment length can be edited) "RTN","SDEC26",7,0) ;EDITAPPT(SDECY,SDECAPTID,SDECNOTE,SDECLEN) external parameter tag is in SDEC "RTN","SDEC26",8,0) ; SDECAPTID - Appointment ID - Pointer to SDEC APPOINTMENT "RTN","SDEC26",9,0) ; SDECNOTE - Note "RTN","SDEC26",10,0) ; SDECLEN - If there is a change in the length of appointment, this is the new value (in minutes) for length "RTN","SDEC26",11,0) ; "RTN","SDEC26",12,0) N SDECAP,SDECCL,SDECNEND,SDECNOD,SDECOLEN,SDECPAT,SDECPATID,SDECRES,SDECSTART "RTN","SDEC26",13,0) N DIK,DA,INP,SDECID,SDECI,SDECZ,SDECIENS,SDECEND "RTN","SDEC26",14,0) ; "RTN","SDEC26",15,0) S SDECI=0 "RTN","SDEC26",16,0) K ^TMP("SDEC",$J) "RTN","SDEC26",17,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDEC26",18,0) S ^TMP("SDEC",$J,SDECI)="T00020ERRORID"_$C(30) "RTN","SDEC26",19,0) S SDECI=SDECI+1 "RTN","SDEC26",20,0) ;validate SDEC appointment pointer "RTN","SDEC26",21,0) I '+SDECAPTID D ERR(SDECI,"SDEC26: Invalid Appointment ID") Q "RTN","SDEC26",22,0) I '$D(^SDEC(409.84,SDECAPTID,0)) D ERR(SDECI,"SDEC26: Invalid Appointment ID") Q "RTN","SDEC26",23,0) ;alb/sat 658 begin "RTN","SDEC26",24,0) N SDID,SDNOD,SDRET,SDTYP ;check if request is open "RTN","SDEC26",25,0) S SDNOD=$G(^SDEC(409.84,SDECAPTID,0)) "RTN","SDEC26",26,0) I $P(SDNOD,U,23)="",$P(SDNOD,U,12)="" D "RTN","SDEC26",27,0) .S SDTYP=$P($G(^SDEC(409.84,SDECAPTID,2)),U,1) "RTN","SDEC26",28,0) .Q:SDTYP="" "RTN","SDEC26",29,0) .S SDID=$P(SDTYP,";",1) "RTN","SDEC26",30,0) .S SDTYP=$S($P(SDTYP,";",2)="SDWL(409.3,":1,$P(SDTYP,";",2)="SDEC(409.85,":2,1:0) "RTN","SDEC26",31,0) .I SDTYP=2,$$GET1^DIQ(409.85,SDID_",",23,"I")="O" D "RTN","SDEC26",32,0) ..S INP(1)=SDID "RTN","SDEC26",33,0) ..S INP(2)="SA" "RTN","SDEC26",34,0) ..S INP(4)=$P(SDNOD,U,9) ;date appt made "RTN","SDEC26",35,0) ..D ARCLOSE1^SDEC(.SDRET,.INP) "RTN","SDEC26",36,0) .I SDTYP=1,$$GET1^DIQ(409.3,SDID_",",23,"I")="O" D "RTN","SDEC26",37,0) ..S INP(1)=SDID "RTN","SDEC26",38,0) ..S INP(2)="SA" "RTN","SDEC26",39,0) ..S INP(4)=$P(SDNOD,U,9) ;date appt made "RTN","SDEC26",40,0) ..D WLCLOSE1^SDEC(.SDRET,.INP) "RTN","SDEC26",41,0) ..;end check if request is open "RTN","SDEC26",42,0) S SDECNOTE=$G(SDECNOTE) S:SDECNOTE'="" SDECNOTE=$E(SDECNOTE,1,150),SDECNOTE=$TR(SDECNOTE,"^"," ") ;alb/sat 658 - only use 1st 150 characters "RTN","SDEC26",43,0) D:SDECNOTE'="" SETNOTE(SDECAPTID,SDECNOTE) "RTN","SDEC26",44,0) ;alb/sat 658 end "RTN","SDEC26",45,0) ; "RTN","SDEC26",46,0) ;Edit appointment length "RTN","SDEC26",47,0) I $G(SDECLEN),$G(SDECLEN)>0 D "RTN","SDEC26",48,0) . S SDECSTART=$$GET1^DIQ(409.84,SDECAPTID,.01,"I"),SDECEND=$$GET1^DIQ(409.84,SDECAPTID,.02,"I") "RTN","SDEC26",49,0) . S SDECOLEN=$$FMDIFF^XLFDT(SDECEND,SDECSTART,2),SDECOLEN=SDECOLEN/60 "RTN","SDEC26",50,0) . Q:SDECOLEN=SDECLEN "RTN","SDEC26",51,0) . S SDECRES=$$GET1^DIQ(409.84,SDECAPTID,.07,"I") Q:'SDECRES "RTN","SDEC26",52,0) . S SDECPAT=$$GET1^DIQ(409.84,SDECAPTID,.05,"I") Q:'SDECPAT "RTN","SDEC26",53,0) . S SDECCL=$$GET1^DIQ(409.831,SDECRES,.04,"I") Q:'SDECCL "RTN","SDEC26",54,0) . S SDECAP=0 F S SDECAP=$O(^SC(SDECCL,"S",SDECSTART,1,SDECAP)) Q:'SDECAP D "RTN","SDEC26",55,0) . . S SDECIENS=SDECAP_","_SDECSTART_","_SDECCL_"," "RTN","SDEC26",56,0) . . I $$GET1^DIQ(44.003,SDECIENS,.01,"I")=SDECPAT,$$GET1^DIQ(44.003,SDECIENS,1,"I")=SDECOLEN D "RTN","SDEC26",57,0) . . . S FDA(44.003,SDECIENS,1)=SDECLEN D FILE^DIE(,"FDA") K FDA "RTN","SDEC26",58,0) . . . S SDECNEND=$$FMADD^XLFDT(SDECSTART,,,SDECLEN) "RTN","SDEC26",59,0) . . . S FDA(409.84,SDECAPTID_",",.02)=SDECNEND "RTN","SDEC26",60,0) . . . S FDA(409.84,SDECAPTID_",",.18)=SDECLEN "RTN","SDEC26",61,0) . . . D FILE^DIE(,"FDA") K FDA "RTN","SDEC26",62,0) ; "RTN","SDEC26",63,0) ;Return Recordset "RTN","SDEC26",64,0) S SDECI=SDECI+1 "RTN","SDEC26",65,0) S ^TMP("SDEC",$J,SDECI)="-1"_$C(30) "RTN","SDEC26",66,0) S SDECI=SDECI+1 "RTN","SDEC26",67,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC26",68,0) Q "RTN","SDEC26",69,0) SETNOTE(APID,NOTE) ;set note to SDEC APPOINTMENT and file 44-APPOINTMENT-OTHER alb/sat 658 "RTN","SDEC26",70,0) N DFN,DIC,DA,FDA,IENS,X,Y,DLAYGO,DD,DO,DINUM "RTN","SDEC26",71,0) N SDCL,SDID,SDRES,SDRTYP,SDT "RTN","SDEC26",72,0) S NOTE=$G(NOTE) "RTN","SDEC26",73,0) Q:NOTE="" "RTN","SDEC26",74,0) S:NOTE'="" NOTE=$E(NOTE,1,150) "RTN","SDEC26",75,0) S DFN=$$GET1^DIQ(409.84,APID_",",.05,"I") "RTN","SDEC26",76,0) S SDRES=$$GET1^DIQ(409.84,APID_",",.07,"I") "RTN","SDEC26",77,0) Q:SDRES="" "RTN","SDEC26",78,0) S SDRTYP=$$GET1^DIQ(409.831,SDRES_",",.012,"I") "RTN","SDEC26",79,0) Q:$P(SDRTYP,";",2)'="SC(" "RTN","SDEC26",80,0) S SDCL=$P(SDRTYP,";",1) "RTN","SDEC26",81,0) S SDT=$$GET1^DIQ(409.84,APID_",",.01,"I") "RTN","SDEC26",82,0) S SDID=0 F S SDID=$O(^SC(SDCL,"S",SDT,1,SDID)) Q:SDID="" Q:(($P($G(^SC(SDCL,"S",SDT,1,SDID,0)),U,9)'="C")&(+$G(^SC(SDCL,"S",SDT,1,SDID,0))=DFN)) ;*zeb 722 2/21/19 skip cancelled appts "RTN","SDEC26",83,0) Q:SDID="" "RTN","SDEC26",84,0) S IENS=SDID_","_SDT_","_SDCL_"," "RTN","SDEC26",85,0) S FDA(44.003,IENS,3)=NOTE "RTN","SDEC26",86,0) ;S FDA(44.003,IENS,7)=DUZ ;alb/sat 658 - removed "RTN","SDEC26",87,0) ;S FDA(44.003,IENS,8)=$$NOW^XLFDT ;alb/sat 658 - removed "RTN","SDEC26",88,0) D UPDATE^DIE("","FDA") "RTN","SDEC26",89,0) ;S DIC="^SC("_SDCL_",""S"","_SDT_",1,"_SDID "RTN","SDEC26",90,0) ;S DA(3)=SDCL,DA(2)=SDT,DA(1)=SDID,X=DFN "RTN","SDEC26",91,0) ;S DIC("DR")="3///"_$E(NOTE,1,150)_";7////"_DUZ_";8////"_$$NOW^XLFDT "RTN","SDEC26",92,0) ;S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003 "RTN","SDEC26",93,0) ;D FILE^DICN "RTN","SDEC26",94,0) D SDECWP^SDEC07(APID,NOTE) "RTN","SDEC26",95,0) Q "RTN","SDEC26",96,0) ; "RTN","SDEC26",97,0) ; "RTN","SDEC26",98,0) ERR(SDECI,SDECERR) ;Error processing "RTN","SDEC26",99,0) S SDECI=SDECI+1 "RTN","SDEC26",100,0) S ^TMP("SDEC",$J,SDECI)=SDECERR_$C(30) "RTN","SDEC26",101,0) S SDECI=SDECI+1 "RTN","SDEC26",102,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC26",103,0) Q "RTN","SDEC26",104,0) ; "RTN","SDEC26",105,0) ETRAP ;EP Error trap entry "RTN","SDEC26",106,0) D ^%ZTER "RTN","SDEC26",107,0) I '$D(SDECI) N SDECI S SDECI=999999 "RTN","SDEC26",108,0) S SDECI=SDECI+1 "RTN","SDEC26",109,0) D ERR(SDECI,"SDEC26 Error") "RTN","SDEC26",110,0) Q "RTN","SDEC50") 0^2^B161237359^B102324779 "RTN","SDEC50",1,0) SDEC50 ;ALB/SAT/JSM - VISTA SCHEDULING RPCS ; 22 Mar 2019 3:20 PM "RTN","SDEC50",2,0) ;;5.3;Scheduling;**627,658,665,672,722**;Aug 13, 1993;Build 26 "RTN","SDEC50",3,0) ; "RTN","SDEC50",4,0) Q "RTN","SDEC50",5,0) ; "RTN","SDEC50",6,0) FAPPTGET(SDECY,DFN,SDBEG,SDEND,SDANC) ; GET Future appointments for given patient and date range "RTN","SDEC50",7,0) ;FAPPTGET(SDECY,DFN,SDBEG,SDEND,SDANC) external parameter tag is in SDEC "RTN","SDEC50",8,0) ;INPUT: "RTN","SDEC50",9,0) ; DFN = (required) Patient ID - Pointer to the PATIENT file 2 (lookup by name is not accurate if duplicates) "RTN","SDEC50",10,0) ; SDBEG = (required) Begin of date range to search for appointments in external format "RTN","SDEC50",11,0) ; SDEND = (required) End of date range to search for appointments in external format "RTN","SDEC50",12,0) ; SDANC = (optional) ancillary flag 0=all appointments; 1=only ancillary appointments "RTN","SDEC50",13,0) ;RETURN: "RTN","SDEC50",14,0) ; Successful Return: "RTN","SDEC50",15,0) ; Global Array in which each array entry contains Appointment Data from the PATIENT file "RTN","SDEC50",16,0) ; Data is separated by ^: "RTN","SDEC50",17,0) ; 1. DFN "RTN","SDEC50",18,0) ; 2. CLINIC_IEN - Clinic IEN "RTN","SDEC50",19,0) ; 3. CLINIC_NAME - Clinic Name "RTN","SDEC50",20,0) ; 4. APPT_DATE - Appointment Date in external format "RTN","SDEC50",21,0) ; 5. STATUS - Status text "RTN","SDEC50",22,0) ; 6. ANCTXT - Ancillary Text "RTN","SDEC50",23,0) ; 7. CONS -Consult Link pointer to REQUEST/CONSULTATION file 123 "RTN","SDEC50",24,0) ; "T00020DFN^T00020CLINIC_IEN^T00030CLINIC_NAME^T00020APPT_DATE^T00020STATUS^T00100ANCTXT^T00030CONS" "RTN","SDEC50",25,0) ; Caught Exception Return: "RTN","SDEC50",26,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDEC50",27,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",28,0) ; Unexpected Exception Return: "RTN","SDEC50",29,0) ; Handled by the RPC Broker. "RTN","SDEC50",30,0) ; M errors are trapped by the use of M and Kernel error handling. "RTN","SDEC50",31,0) ; The RPC execution stops and the RPC Broker sends the error generated "RTN","SDEC50",32,0) ; text back to the client. "RTN","SDEC50",33,0) ; "RTN","SDEC50",34,0) N IEN,SDANCT,SDCL,SDCLN,SDCONS,SDATA,SDDT,SDST,SDT,X,Y,%DT "RTN","SDEC50",35,0) N SDTMP,SDTYP,SDTYPN,SDNOD,SDRES ;alb/sat 672 ;*zeb 722 1/9/19 added SDNOD,SDRES "RTN","SDEC50",36,0) S SDECI=0 "RTN","SDEC50",37,0) K ^TMP("SDEC50",$J) "RTN","SDEC50",38,0) S SDECY="^TMP(""SDEC50"","_$J_")" "RTN","SDEC50",39,0) ; data header "RTN","SDEC50",40,0) S SDTMP="T00020DFN^T00020CLINIC_IEN^T00030CLINIC_NAME^T00020APPT_DATE^T00020STATUS^T00100ANCTXT" "RTN","SDEC50",41,0) S SDTMP=SDTMP_"^T00030CONS^T00030IEN^T00030APPTYPE_IEN^T00030APPTYPE_NAME" ;alb/sat 658 add IEN ;alb/sat 672 add APPTYPE "RTN","SDEC50",42,0) S @SDECY@(0)=SDTMP_$C(30) "RTN","SDEC50",43,0) ;validate Patient (required) "RTN","SDEC50",44,0) I '+DFN D ERR1^SDECERR(-1,"Invalid Patient ID.",.SDECI,SDECY) Q "RTN","SDEC50",45,0) I '$D(^DPT(DFN,0)) D ERR1^SDECERR(-1,"Invalid Patient ID.",.SDECI,SDECY) Q "RTN","SDEC50",46,0) ;validate begin date/time (required) "RTN","SDEC50",47,0) S:$G(SDBEG)="" SDBEG=$P($$NOW^XLFDT,".",1) "RTN","SDEC50",48,0) S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y "RTN","SDEC50",49,0) I Y=-1 D ERR1^SDECERR(-1,"Invalid Begin Time.",.SDECI,SDECY) Q "RTN","SDEC50",50,0) ;validate end date/time (required) "RTN","SDEC50",51,0) S:$G(SDEND)="" SDEND=1000000 "RTN","SDEC50",52,0) S %DT="" S X=$P(SDEND,"@",1) D ^%DT S SDEND=Y "RTN","SDEC50",53,0) I Y=-1 D ERR1^SDECERR(-1,"Invalid End Time.",.SDECI,SDECY) Q "RTN","SDEC50",54,0) ;validate ancillary flag (optional) "RTN","SDEC50",55,0) S SDANC=$G(SDANC) "RTN","SDEC50",56,0) S:SDANC'=1 SDANC=0 "RTN","SDEC50",57,0) ;*zeb 722 1/9/19 begin new loop over appts instead of pt "RTN","SDEC50",58,0) S SDT=SDBEG "RTN","SDEC50",59,0) F S SDT=$O(^SDEC(409.84,"APTDT",DFN,SDT)) Q:SDT="" Q:$P(SDT,".",1)>SDEND D "RTN","SDEC50",60,0) . S IEN="" "RTN","SDEC50",61,0) . F S IEN=$O(^SDEC(409.84,"APTDT",DFN,SDT,IEN)) Q:IEN="" D "RTN","SDEC50",62,0) .. S SDNOD=$G(^SDEC(409.84,IEN,0)) "RTN","SDEC50",63,0) .. Q:SDNOD="" ;appointment data missing "RTN","SDEC50",64,0) .. S SDATA=$G(^DPT(DFN,"S",SDT,0)) "RTN","SDEC50",65,0) .. S SDANCT=$$ANC^SDAM1() ;assumes SDATA ;ancillary "RTN","SDEC50",66,0) .. I SDANC Q:SDANCT="" "RTN","SDEC50",67,0) .. ;return appointment data "RTN","SDEC50",68,0) .. S SDRES=$P(SDNOD,U,7) "RTN","SDEC50",69,0) .. I SDRES]"" S SDCL=$$GET1^DIQ(409.831,SDRES_",",.04,"I") S SDCLN=$$GET1^DIQ(409.831,SDRES_",",.04) ;clinic IEN/clinic name "RTN","SDEC50",70,0) .. S SDDT=$$GET1^DIQ(409.84,IEN_",",.01) ;appointment start date/time ;used GET1 instead of ^DD("DD") because GUI needs leading zeroes "RTN","SDEC50",71,0) .. S SDST=$$APPTSTS(IEN,SDNOD) ;current status "RTN","SDEC50",72,0) .. S SDTYP=$P(SDNOD,U,6) ;appt type id "RTN","SDEC50",73,0) .. S SDTYPN=$P($G(^SD(409.1,SDTYP,0)),U,1) ;appt type name "RTN","SDEC50",74,0) .. S CONS=$$CONS(SDCL,DFN,SDT) "RTN","SDEC50",75,0) .. S SDECI=SDECI+1 S @SDECY@(SDECI)=DFN_U_SDCL_U_SDCLN_U_SDDT_U_SDST_U_SDANCT_U_CONS_U_IEN_U_SDTYP_U_SDTYPN_$C(30) "RTN","SDEC50",76,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDEC50",77,0) Q "RTN","SDEC50",78,0) ; "RTN","SDEC50",79,0) ;*zeb+tag 722 2/19/19 added to get appointment status for pending appointments from appointment file "RTN","SDEC50",80,0) APPTSTS(APPTIEN,APPTNOD) ;Get current status for an entry in the SDEC APPOINTMENT file in the style of STATUS^SDAM1 "RTN","SDEC50",81,0) ;APPTIEN (R) - IEN of entry in the SDEC APPOINTMENT file (#409.84) "RTN","SDEC50",82,0) ;APPTNOD (O) - 0 node of appointment entry (will be read if not passed in) "RTN","SDEC50",83,0) N STS,RSCIEN,CLINIEN,OEIEN,DFN,SDT,VAINDT,VADMVT,CHKIO,RET,OESTS "RTN","SDEC50",84,0) I $G(APPTNOD)="" S APPTNOD=$G(^SDEC(409.84,APPTIEN,0)) "RTN","SDEC50",85,0) S SDT=$P(APPTNOD,U,1) "RTN","SDEC50",86,0) S DFN=$P(APPTNOD,U,5) "RTN","SDEC50",87,0) S RSCIEN=$P(APPTNOD,U,7) "RTN","SDEC50",88,0) S CLINIEN=$P($G(^SDEC(409.831,RSCIEN,0)),U,4) "RTN","SDEC50",89,0) S OEIEN=$P($G(^DPT(DFN,"S",SDT,0)),U,20) "RTN","SDEC50",90,0) S CHKIO="" "RTN","SDEC50",91,0) ; -- set initial status value ; non-count clinic? "RTN","SDEC50",92,0) S STS=$P(APPTNOD,U,17) "RTN","SDEC50",93,0) I STS]"" S STS=$P($P($P(^DD(409.84,.17,0),"^",3),STS_":",2),";",1) I 1 ;name for status code "RTN","SDEC50",94,0) E S:$P($G(^SC(CLINIEN,0)),U,17)="Y" STS="NON-COUNT" ;check for non-count clinic "RTN","SDEC50",95,0) I (STS="NO ACTION TAKEN") S OEIEN=$$GETAPT^SDVSIT2(DFN,SDT,CLINIEN) S:OEIEN]"" STS="" "RTN","SDEC50",96,0) ; -- no show? "RTN","SDEC50",97,0) I $P(APPTNOD,U,10)=1 D "RTN","SDEC50",98,0) . I $P(APPTNOD,U,12)]"" D Q ;handle cancel after no-show -- appt sts doesn't get updated with cxl but pt status does "RTN","SDEC50",99,0) . . S CXLRSN=$P(APPTNOD,U,22) "RTN","SDEC50",100,0) . . I CXLRSN="" S STS="CANCELLED" Q ;cancel reason is required, this should not happen "RTN","SDEC50",101,0) . . S CXLRSNTP=$P($G(^SD(409.2,CXLRSN,0)),U,2) "RTN","SDEC50",102,0) . . I CXLRSNTP="C" S STS="CANCELLED BY CLINIC" Q "RTN","SDEC50",103,0) . . I CXLRSNTP="P" S STS="CANCELLED BY PATIENT" Q "RTN","SDEC50",104,0) . . ;only reasons that can be either are left, check pt file status -- could be overlaid after cancel "RTN","SDEC50",105,0) . . S CXLSTS=$$GET1^DIQ(2.98,SDT_","_DFN_",",100) "RTN","SDEC50",106,0) . . I CXLSTS["CANCELLED" S STS=CXLSTS Q "RTN","SDEC50",107,0) . . S STS="CANCELLED BY CLINIC" ;must specify clinic or patient, default to clinic if information is lost "RTN","SDEC50",108,0) . S STS="NO-SHOW" "RTN","SDEC50",109,0) ; -- inpatient? "RTN","SDEC50",110,0) ; WTC 722 3/22/19 ; I STS="" S:$$INP^SDAM2(DFN,SDT)="I" STS="INPATIENT" "RTN","SDEC50",111,0) I STS=""!($P(APPTNOD,U,17)="I"),$$INP^SDAM2(DFN,SDT)="I" S STS=$S($P(APPTNOD,U,12)="":"INPATIENT",1:"INPATIENT/CANCELLED") ; "RTN","SDEC50",112,0) S VAINDT=SDT D ADM^VADPT2 ;ADM^VADPT2 assumes VAINDT and returns in VADMVT "RTN","SDEC50",113,0) I STS["INPATIENT",$S('VADMVT:1,'$P(^DG(43,1,0),U,21):0,1:$P($G(^DIC(42,+$P($G(^DGPM(VADMVT,0)),U,6),0)),U,3)="D") S STS="" "RTN","SDEC50",114,0) ; -- determine ci/co indicator "RTN","SDEC50",115,0) S CHKIO=$S($P(APPTNOD,U,14)]"":"CHECKED OUT",$P(APPTNOD,U,3)]"":"CHECKED IN",SDT>(DT+.2400):"FUTURE",1:"NO ACTION TAKEN") ;DT is a FileMan-assumable variable with the current date "RTN","SDEC50",116,0) S:STS="" STS=CHKIO "RTN","SDEC50",117,0) I (STS="NO ACTION TAKEN"),($P(SDT,".")=DT),(CHKIO'["CHECKED") S CHKIO="TODAY" "RTN","SDEC50",118,0) ; -- determine print status "RTN","SDEC50",119,0) I STS["CANCELLED" Q STS "RTN","SDEC50",120,0) S RET=$S(STS=CHKIO!(CHKIO=""):STS,1:"") "RTN","SDEC50",121,0) I RET="" D "RTN","SDEC50",122,0) . I (STS["INPATIENT"),($P($G(^SC(CLINIEN,0)),U,17)'="Y"),OEIEN="" S RET=$P(STS," ",1)_"/ACT REQ" Q ; wtc 3/22/19 722 no outpatient encounter for inpatient "RTN","SDEC50",123,0) . I (STS["INPATIENT"),($P($G(^SC(CLINIEN,0)),U,17)'="Y"),($P($G(^SCE(OEIEN,0)),U,7)="") S RET=$P(STS," ",1)_"/ACT REQ" Q "RTN","SDEC50",124,0) . I (STS="NO ACTION TAKEN"),((CHKIO="CHECKED OUT")!(CHKIO="CHECKED IN")) S RET="ACT REQ/"_CHKIO D Q "RTN","SDEC50",125,0) . . I (OEIEN),($P($G(^SCE(OEIEN,0)),U,7)) S P="CHECKED OUT" "RTN","SDEC50",126,0) . I ((STS="NO-SHOW")!(STS="NON-COUNT")) S RET=STS Q:CHKIO="NO ACTION TAKEN" "RTN","SDEC50",127,0) . S RET=STS_"/"_CHKIO "RTN","SDEC50",128,0) I STS["INPATIENT",((CHKIO="")!(CHKIO="NO ACTION TAKEN")) D "RTN","SDEC50",129,0) . I SDT>(DT+.2359) S RET=$P(STS," ")_"/FUTURE" Q "RTN","SDEC50",130,0) . S RET=$P(STS," ")_"/NO ACT TAKN" "RTN","SDEC50",131,0) I STS["INPATIENT" Q RET "RTN","SDEC50",132,0) I STS["NO-SHOW" Q RET "RTN","SDEC50",133,0) I ($G(OEIEN)),($D(^SCE(OEIEN,0))) D "RTN","SDEC50",134,0) . S OESTS=$P($G(^SCE(OEIEN,0)),U,12) "RTN","SDEC50",135,0) . S:OESTS]"" OESTS=$P($G(^SD(409.63,OESTS,0)),U,1) "RTN","SDEC50",136,0) . I $G(OESTS)="NON-COUNT" D Q "RTN","SDEC50",137,0) . . I $P(APPTNOD,U,14) S RET="NON-COUNT/CHECKED OUT" Q "RTN","SDEC50",138,0) . . I $P(APPTNOD,U,3) S RET="NON-COUNT/CHECKED IN" "RTN","SDEC50",139,0) . I $G(OESTS)="CHECKED OUT" S RET="CHECKED OUT" Q "RTN","SDEC50",140,0) . I $P(APPTNOD,U,14) S RET="ACT REQ/CHECKED OUT" D Q "RTN","SDEC50",141,0) . . I ($G(OESTS)=""),($P($G(^SCE(OEIEN,0)),U,7)) S RET="CHECKED OUT" "RTN","SDEC50",142,0) . I $P(APPTNOD,U,3) S RET="ACT REQ/CHECKED IN" "RTN","SDEC50",143,0) Q RET "RTN","SDEC50",144,0) ; "RTN","SDEC50",145,0) GETIEN(DFN,SDCLN,SDDT) ;get SDEC APPOINTMENT id "RTN","SDEC50",146,0) N SDF,SDI,SDNOD,SDR "RTN","SDEC50",147,0) Q:$G(DFN)="" "" "RTN","SDEC50",148,0) Q:$G(SDCLN)="" "" "RTN","SDEC50",149,0) Q:$G(SDDT)="" "" "RTN","SDEC50",150,0) S (SDF,SDI)=0 F S SDI=$O(^SDEC(409.84,"CPAT",DFN,SDI)) Q:SDI="" D Q:SDF=1 "RTN","SDEC50",151,0) .S SDNOD=$G(^SDEC(409.84,SDI,0)) "RTN","SDEC50",152,0) .Q:SDNOD="" "RTN","SDEC50",153,0) .S SDR=$$GETRES^SDECUTL(SDCLN) "RTN","SDEC50",154,0) .I $P(SDNOD,U,1)=SDDT,$P(SDNOD,U,7)=SDR S SDF=1 "RTN","SDEC50",155,0) Q $S(SDI'="":SDI,1:"") "RTN","SDEC50",156,0) ; "RTN","SDEC50",157,0) CONS(SDCL,DFN,SDDT) ;check for consult in file 44 "RTN","SDEC50",158,0) ; SDCL = (required) clinic IEN "RTN","SDEC50",159,0) ; DFN = (required) patient IEN "RTN","SDEC50",160,0) ; SDDT = (required) appointment time in FM format "RTN","SDEC50",161,0) N CONS,CSTAT,SDI,SDJ "RTN","SDEC50",162,0) S CONS="" "RTN","SDEC50",163,0) S SDI=0 F S SDI=$O(^SC(SDCL,"S",SDDT,1,SDI)) Q:SDI'>0 D Q:CONS'="" "RTN","SDEC50",164,0) .I $P($G(^SC(SDCL,"S",SDDT,1,SDI,0)),U,1)=DFN D "RTN","SDEC50",165,0) ..S CONS=$G(^SC(SDCL,"S",SDDT,1,SDI,"CONS")) "RTN","SDEC50",166,0) ..I +CONS D "RTN","SDEC50",167,0) ...S CSTAT=$P($G(^GMR(123,CONS,0)),U,12) "RTN","SDEC50",168,0) ...S:(CSTAT=1!(CSTAT=2)!(CSTAT=13)) CONS="" "RTN","SDEC50",169,0) Q CONS "RTN","SDEC50",170,0) ; "RTN","SDEC50",171,0) PCSTGET(SDECY,DFN,SDCL,SDBEG,SDEND) ;GET patient clinic status for a clinic for a given time frame - has the patient been seen by the given Clinic in the past 24 months "RTN","SDEC50",172,0) ;PCSTGET(SDECY,DFN,SDCL,SDBEG,SDEND) external parameter tag is in SDEC "RTN","SDEC50",173,0) ;INPUT: "RTN","SDEC50",174,0) ; DFN = (required) Patient ID - Pointer to the PATIENT file 2 (lookup by name is not accurate if duplicates) "RTN","SDEC50",175,0) ; SDCL = (required) Clinic code - Pointer to HOSPITAL LOCATION file "RTN","SDEC50",176,0) ; SDBEG = (optional) Begin date in external format; defaults to 730 days previous (24 months) "RTN","SDEC50",177,0) ; SDEND = (optional) End date in external format; defaults to today "RTN","SDEC50",178,0) ;RETURN: "RTN","SDEC50",179,0) ; Successful Return: "RTN","SDEC50",180,0) ; a single entry in the global array indicating that patient has or has "RTN","SDEC50",181,0) ; not been seen. "RTN","SDEC50",182,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",183,0) ; Caught Exception Return: "RTN","SDEC50",184,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDEC50",185,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",186,0) ; Unexpected Exception Return: "RTN","SDEC50",187,0) ; Handled by the RPC Broker. "RTN","SDEC50",188,0) ; M errors are trapped by the use of M and Kernel error handling. "RTN","SDEC50",189,0) ; The RPC execution stops and the RPC Broker sends the error generated "RTN","SDEC50",190,0) ; text back to the client. "RTN","SDEC50",191,0) N SDASD,SDECI,SDS,STOP,SDYN,SDSCL "RTN","SDEC50",192,0) ;N SDSNOD,SDSD,SDSTP,SDT,SDVSP,SDWL,SDYN alb/jsm 658 commented out since variables not used here "RTN","SDEC50",193,0) N X,Y,%DT,APIEN "RTN","SDEC50",194,0) S SDECI=0 "RTN","SDEC50",195,0) S SDECY="^TMP(""SDEC50"","_$J_",""PCSTGET"")" "RTN","SDEC50",196,0) K @SDECY "RTN","SDEC50",197,0) ; data header "RTN","SDEC50",198,0) S @SDECY@(0)="T00020RETURNCODE^T00100TEXT"_$C(30) "RTN","SDEC50",199,0) ;check for valid Patient "RTN","SDEC50",200,0) I '+DFN D ERR1^SDECERR(-1,"Invalid Patient ID.",SDECI,SDECY) Q "RTN","SDEC50",201,0) I '$D(^DPT(DFN,0)) D ERR1^SDECERR(-1,"Invalid Patient ID.",SDECI,SDECY) Q "RTN","SDEC50",202,0) ;check for valid Clinic "RTN","SDEC50",203,0) I '+SDCL D ERR1^SDECERR(-1,"Invalid Clinic ID.",SDECI,SDECY) Q "RTN","SDEC50",204,0) I '$D(^SC(SDCL,0)) D ERR1^SDECERR(-1,"Invalid Clinic ID.",SDECI,SDECY) Q "RTN","SDEC50",205,0) ;check times "RTN","SDEC50",206,0) I $G(SDBEG)'="" S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y I Y=-1 S SDBEG="" "RTN","SDEC50",207,0) S:$G(SDBEG)="" SDBEG=$P($$FMADD^XLFDT($$NOW^XLFDT,-730),".",1) "RTN","SDEC50",208,0) I $G(SDEND)'="" S %DT="" S X=$P(SDEND,"@",1) D ^%DT S SDEND=Y I Y=-1 S SDEND="" ;alb/sat 665 - remove Q "RTN","SDEC50",209,0) S:$G(SDEND)="" SDEND=$P($$NOW^XLFDT,".",1) "RTN","SDEC50",210,0) S STOP=$$CLSTOP(SDCL) ;get stop code number alb/jsm 658 updated to use new CLSTOP call "RTN","SDEC50",211,0) I '+STOP D ERR1^SDECERR(-1,"Clinic "_$P($G(^SC(+$G(SDCL),0)),U,1)_" does not have a STOP CODE NUMBER defined.",SDECI,SDECY) Q "RTN","SDEC50",212,0) S SDYN="NO" "RTN","SDEC50",213,0) ;look in SD WAIT LIST file for SDSCN stop code "RTN","SDEC50",214,0) ; alb/jsm 658 removed this block of code "RTN","SDEC50",215,0) ;S SDWL="" F S SDWL=$O(^SDWL(409.3,"B",DFN,SDWL)) Q:SDWL="" D Q:SDYN="YES" "RTN","SDEC50",216,0) ;.S SDSD=$P($G(^SDWL(409.3,SDWL,0)),U,23) "RTN","SDEC50",217,0) ;.I (SDSD'SDEND) D "RTN","SDEC50",218,0) ;..S SDSTP=$P($G(^SDWL(409.3,SDWL,"SDAPT")),U,4) "RTN","SDEC50",219,0) ;..I SDSTP=SDSCN S SDYN="YES" "RTN","SDEC50",220,0) ;.Q:SDYN="YES" "RTN","SDEC50",221,0) ;look in PATIENT Appointments "RTN","SDEC50",222,0) ; alb/jsm 658 updated to look at stop codes and check-out time "RTN","SDEC50",223,0) ;I SDYN'="YES" D "RTN","SDEC50",224,0) ;.S SDS="" F S SDS=$O(^DPT(DFN,"S",SDS)) Q:SDS="" D Q:SDYN="YES" "RTN","SDEC50",225,0) ;..S SDSD=$$GET1^DIQ(2.98,SDS_","_DFN_",",.001,"I") "RTN","SDEC50",226,0) ;..I (SDSD'SDEND) D "RTN","SDEC50",227,0) ;...I $P($G(^DPT(DFN,"S",SDS,0)),U,1)=SDCL D "RTN","SDEC50",228,0) ;....S APIEN=$$FIND^SDAM2(DFN,SDS,SDCL) "RTN","SDEC50",229,0) ;....Q:APIEN="" "RTN","SDEC50",230,0) ;....S:$G(^SC(SDCL,"S",SDS,1,+APIEN,"C"))'="" SDYN="YES" "RTN","SDEC50",231,0) ;S (SDS,SDSCL)="" F S SDS=$O(^DPT(DFN,"S",SDS)) Q:SDS="" D Q:SDYN="YES" "RTN","SDEC50",232,0) ;.S SDSCL=$P($G(^DPT(DFN,"S",SDS,0)),U,1) "RTN","SDEC50",233,0) ;.I $$CLSTOP(SDSCL)=SDSCN D "RTN","SDEC50",234,0) ;..S APIEN=$$FIND^SDAM2(DFN,SDS,SDSCL) "RTN","SDEC50",235,0) ;..Q:APIEN="" "RTN","SDEC50",236,0) ;..S SDSCO=$P($G(^SC(SDSCL,"S",SDS,1,+APIEN,"C")),U,3) "RTN","SDEC50",237,0) ;..S:(SDSCO'="")&(SDSCO'SDEND) SDYN="YES" "RTN","SDEC50",238,0) D CHKPT "RTN","SDEC50",239,0) ;look in HOSPITAL LOCATION "RTN","SDEC50",240,0) ; alb/jsm 658 removing this block of code since we already loop through patient appointments for evaluation "RTN","SDEC50",241,0) ;I SDYN'="YES" D "RTN","SDEC50",242,0) ;.S SDS=SDBEG F S SDS=$O(^SC(SDCL,"S",SDS)) Q:SDS'>0 Q:SDS>SDEND D Q:SDYN="YES" "RTN","SDEC50",243,0) ;..S APIEN=$$FIND^SDAM2(DFN,SDS,SDCL) "RTN","SDEC50",244,0) ;..Q:APIEN="" "RTN","SDEC50",245,0) ;..S:$P($G(^SC(SDCL,"S",SDS,1,APIEN,"C")),U,1)'="" SDYN="YES" "RTN","SDEC50",246,0) S SDECI=SDECI+1 S @SDECY@(SDECI)="0^"_SDYN_$C(30,31) "RTN","SDEC50",247,0) Q "RTN","SDEC50",248,0) ; "RTN","SDEC50",249,0) CLSTOP(CLINIC) ;Return clinic stop code for clinic "RTN","SDEC50",250,0) Q:$G(CLINIC)="" 0 ;Verify clinic is passed in "RTN","SDEC50",251,0) Q $P($G(^SC(CLINIC,0)),U,7) ;Return the stop code for the clinic "RTN","SDEC50",252,0) ; "RTN","SDEC50",253,0) CHKPT ; alb/jsm 658 added to be used by PCSTGET and PCST2GET "RTN","SDEC50",254,0) N SDSCO "RTN","SDEC50",255,0) S SDS=0 F S SDS=$O(^DPT(DFN,"S",SDS)) Q:SDS="" D Q:SDYN="YES" ;alb/sat 665 - start with SDS=0 instead of "" "RTN","SDEC50",256,0) .S SDSCL=$P($G(^DPT(DFN,"S",SDS,0)),U,1) "RTN","SDEC50",257,0) .I $$CLSTOP(SDSCL)=STOP D "RTN","SDEC50",258,0) ..S APIEN=$$FIND^SDAM2(DFN,SDS,SDSCL) "RTN","SDEC50",259,0) ..Q:APIEN="" "RTN","SDEC50",260,0) ..S SDSCO=$P($P($G(^SC(SDSCL,"S",SDS,1,+APIEN,"C")),U,3),".",1) "RTN","SDEC50",261,0) ..S:(SDSCO'="")&(SDSCO'SDEND) SDYN="YES" "RTN","SDEC50",262,0) Q "RTN","SDEC50",263,0) ; "RTN","SDEC50",264,0) PCST2GET(SDECY,DFN,STOP,SDBEG,SDEND) ;GET patient clinic status for a service/specialty (clinic stop) for a given time frame - has the patient been seen any clinics with the given service/specialty (clinic stop) in the past 24 months "RTN","SDEC50",265,0) ;PCST2GET(SDECY,DFN,STOP,SDBEG,SDEND) external parameter tag is in SDEC "RTN","SDEC50",266,0) ;INPUT: "RTN","SDEC50",267,0) ; DFN = (required) Patient ID - Pointer to the PATIENT file 2 (lookup by name is not accurate if duplicates) "RTN","SDEC50",268,0) ; STOP = (required) CLINIC STOP or Service/Specialty name - NAME from the SD WL SERVICE/SPECIALTY file - looks for 1st active "RTN","SDEC50",269,0) ; OR - Pointer to the CLINIC STOP file "RTN","SDEC50",270,0) ; SDBEG = (optional) Begin date in external format; defaults to 730 days previous (24 months) "RTN","SDEC50",271,0) ; SDEND = (optional) End date in external format; defaults to today "RTN","SDEC50",272,0) ;RETURN: "RTN","SDEC50",273,0) ; Successful Return: "RTN","SDEC50",274,0) ; a single entry in the global array indicating that patient has or has "RTN","SDEC50",275,0) ; not been seen. "RTN","SDEC50",276,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",277,0) ; Caught Exception Return: "RTN","SDEC50",278,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDEC50",279,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",280,0) ; Unexpected Exception Return: "RTN","SDEC50",281,0) ; Handled by the RPC Broker. "RTN","SDEC50",282,0) ; M errors are trapped by the use of M and Kernel error handling. "RTN","SDEC50",283,0) ; The RPC execution stops and the RPC Broker sends the error generated "RTN","SDEC50",284,0) ; text back to the client. "RTN","SDEC50",285,0) N SDASD,SDF,SDSCN,SDECI,SDSNOD,SDSD,SDSTP,SDT,SDVSP,SDWL,SDYN "RTN","SDEC50",286,0) N H,WLSRVSP,X,Y,%DT "RTN","SDEC50",287,0) S WLSRVSP="" "RTN","SDEC50",288,0) S (SDF,SDECI,SDSCN)=0 "RTN","SDEC50",289,0) S SDECY="^TMP(""SDEC50"","_$J_",""PCST2GET"")" "RTN","SDEC50",290,0) K @SDECY "RTN","SDEC50",291,0) ; data header "RTN","SDEC50",292,0) S @SDECY@(0)="T00020RETURNCODE^T00100TEXT"_$C(30) "RTN","SDEC50",293,0) ;check for valid Patient "RTN","SDEC50",294,0) I '+DFN D ERR1^SDECERR(-1,"Invalid Patient ID.",SDECI,SDECY) Q "RTN","SDEC50",295,0) I '$D(^DPT(DFN,0)) D ERR1^SDECERR(-1,"Invalid Patient ID.",SDECI,SDECY) Q "RTN","SDEC50",296,0) ;check for valid Service/Specialty "RTN","SDEC50",297,0) S STOP=$G(STOP) "RTN","SDEC50",298,0) ;I +SDSVSP,$D(^SDWL(409.31,SDSVSP,0)) S SDSCN=$P($G(^SDWL(409.31,SDSVSP,0)),U,1) S SDF=1 "RTN","SDEC50",299,0) I +STOP,'$D(^DIC(40.7,STOP,0)) D ERR1^SDECERR(-1,"Invalid stop code.",SDECI,SDECY) Q "RTN","SDEC50",300,0) I +STOP S SDSCN=$$GET1^DIQ(40.7,STOP_",",.01) S SDF=1 "RTN","SDEC50",301,0) I 'SDF,'+STOP D "RTN","SDEC50",302,0) .S H="" F S H=$O(^DIC(40.7,"B",STOP,H)) Q:H="" D Q:+STOP "RTN","SDEC50",303,0) ..I $P(^DIC(40.7,H,0),U,3)'="",$P(^DIC(40.7,H,0),U,3)<$$NOW^XLFDT() Q "RTN","SDEC50",304,0) ..S STOP=H "RTN","SDEC50",305,0) I '+STOP D ERR1^SDECERR(-1,"Invalid Stop code.",SDECI,SDECY) Q "RTN","SDEC50",306,0) ;check times "RTN","SDEC50",307,0) I $G(SDBEG)'="" S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y I Y=-1 S SDBEG="" "RTN","SDEC50",308,0) S:$G(SDBEG)="" SDBEG=$P($$FMADD^XLFDT($$NOW^XLFDT,-730),".",1) "RTN","SDEC50",309,0) I $G(SDEND)'="" S %DT="" S X=$P(SDEND,"@",1) D ^%DT S SDEND=Y I Y=-1 S SDEND="" Q "RTN","SDEC50",310,0) S:$G(SDEND)="" SDEND=$P($$NOW^XLFDT,".",1) "RTN","SDEC50",311,0) S SDYN="NO" "RTN","SDEC50",312,0) ;D LOOKWL alb/jsm 658 removed only concerned with patient appts that have a check-out date/time "RTN","SDEC50",313,0) ;I SDYN'="YES" S SDCL=0 F S SDCL=$O(^SC(SDCL)) Q:SDCL'>0 D Q:SDYN="YES" "RTN","SDEC50",314,0) ;.S SDCLN=$$CLSTOP(SDCL) ; alb/jsm 658 updated to use CLSTOP $P($G(^SC(SDCL,0)),U,7) "RTN","SDEC50",315,0) ;.D:SDCLN=STOP LOOK "RTN","SDEC50",316,0) D CHKPT "RTN","SDEC50",317,0) S SDECI=SDECI+1 S @SDECY@(SDECI)="0^"_SDYN_$C(30,31) "RTN","SDEC50",318,0) Q "RTN","SDEC50",319,0) ; "RTN","SDEC50",320,0) LOOK ; "RTN","SDEC50",321,0) ;look in PATIENT Appointments "RTN","SDEC50",322,0) I SDYN'="YES" D "RTN","SDEC50",323,0) .S SDS="" F S SDS=$O(^DPT(DFN,"S",SDS)) Q:SDS="" D Q:SDYN="YES" "RTN","SDEC50",324,0) ..S SDSD=$$GET1^DIQ(2.98,SDS_","_DFN_",",.001,"I") "RTN","SDEC50",325,0) ..I (SDSD'SDEND) D "RTN","SDEC50",326,0) ...I $P($G(^DPT(DFN,"S",SDS,0)),U,1)=SDCL D "RTN","SDEC50",327,0) ....S APIEN=$$FIND^SDAM2(DFN,SDS,SDCL) "RTN","SDEC50",328,0) ....I APIEN'="",$G(^SC(SDCL,"S",SDS,1,APIEN,"C"))'="" S SDYN="YES" "RTN","SDEC50",329,0) ;look in HOSPITAL LOCATION "RTN","SDEC50",330,0) I SDYN'="YES" D "RTN","SDEC50",331,0) .S SDS=SDBEG F S SDS=$O(^SC(SDCL,"S",SDS)) Q:SDS'>0 Q:SDS>SDEND D Q:SDYN="YES" "RTN","SDEC50",332,0) ..S APIEN=$$FIND^SDAM2(DFN,SDS,SDCL) "RTN","SDEC50",333,0) ..Q:APIEN="" "RTN","SDEC50",334,0) ..S:$P($G(^SC(SDCL,"S",SDS,1,APIEN,"C")),U,1)'="" SDYN="YES" "RTN","SDEC50",335,0) Q "RTN","SDEC50",336,0) ; "RTN","SDEC50",337,0) LOOKWL ; "RTN","SDEC50",338,0) ;look in SD WAIT LIST file for STOP stop code "RTN","SDEC50",339,0) S SDWL="" F S SDWL=$O(^SDWL(409.3,"B",DFN,SDWL)) Q:SDWL="" D Q:SDYN="YES" "RTN","SDEC50",340,0) .S SDSD=$P($G(^SDWL(409.3,SDWL,0)),U,23) "RTN","SDEC50",341,0) .I (SDSD'SDEND) D "RTN","SDEC50",342,0) ..S SDSTP=$P($G(^SDWL(409.3,SDWL,"SDAPT")),U,4) "RTN","SDEC50",343,0) ..I SDSTP=STOP S SDYN="YES" "RTN","SDEC50",344,0) .Q:SDYN="YES" "RTN","SDEC50",345,0) Q "RTN","SDEC50",346,0) ; "RTN","SDEC50",347,0) PCSGET(SDECY,SDSVSP,SDCL) ;GET clinics for a service/specialty (clinic stop) ;alb/sat 658 add SDCL "RTN","SDEC50",348,0) ;PCSGET(SDECY,SDSVSP) external parameter tag is in SDEC "RTN","SDEC50",349,0) ;INPUT: "RTN","SDEC50",350,0) ; SDSVSP = (required) Service/Specialty name - NAME from the SD WL SERVICE/SPECIALTY file - looks for 1st active "RTN","SDEC50",351,0) ; OR - Pointer to the SD WL SERVICE/SPECIALTY file "RTN","SDEC50",352,0) ;RETURN: "RTN","SDEC50",353,0) ; Successful Return: "RTN","SDEC50",354,0) ; global array containing Clinic IEN and Name of matching Hospital Locations "RTN","SDEC50",355,0) ; CLINSTOP - pointer to CLINIC STOP file 40.7 "RTN","SDEC50",356,0) ; CLINIEN - pointer to the HOSPITAL LOCATION file 44 "RTN","SDEC50",357,0) ; CLINNAME - NAME from the HOSPITAL LOCATION file "RTN","SDEC50",358,0) ; Caught Exception Return: "RTN","SDEC50",359,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDEC50",360,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC50",361,0) ; Unexpected Exception Return: "RTN","SDEC50",362,0) ; Handled by the RPC Broker. "RTN","SDEC50",363,0) ; M errors are trapped by the use of M and Kernel error handling. "RTN","SDEC50",364,0) ; The RPC execution stops and the RPC Broker sends the error generated "RTN","SDEC50",365,0) ; text back to the client. "RTN","SDEC50",366,0) N SDASD,SDSCN,SDECI,SDSNOD,SDSD,SDSTP,SDT,SDVSP,SDWL "RTN","SDEC50",367,0) N H,WLSRVSP,X,Y "RTN","SDEC50",368,0) S WLSRVSP="" "RTN","SDEC50",369,0) S (SDECI,SDSCN)=0 "RTN","SDEC50",370,0) S SDECY="^TMP(""SDEC50"","_$J_",""PCSGET"")" "RTN","SDEC50",371,0) K @SDECY "RTN","SDEC50",372,0) ; data header "RTN","SDEC50",373,0) S @SDECY@(0)="T00030CLINSTOP^T00030CLINIEN^T00030CLINNAME"_$C(30) "RTN","SDEC50",374,0) ;check clinic ;alb/sat 658 "RTN","SDEC50",375,0) S SDCL=$G(SDCL) "RTN","SDEC50",376,0) I SDCL'="",$D(^SC(SDCL,0)) D "RTN","SDEC50",377,0) .S SDSVSP=$$GET1^DIQ(44,SDCL_",",8,"I") "RTN","SDEC50",378,0) ;check for valid Service/Specialty "RTN","SDEC50",379,0) S SDSVSP=$G(SDSVSP) "RTN","SDEC50",380,0) I SDSVSP="" D ERR1^SDECERR(-1,"Service/Specialty ID required",SDECI,SDECY) Q "RTN","SDEC50",381,0) I +SDSVSP,$D(^SDWL(409.31,+SDSVSP,0)) S SDSCN=$P($G(^SDWL(409.31,SDSVSP,0)),U,1) "RTN","SDEC50",382,0) I '+SDSVSP D "RTN","SDEC50",383,0) .S H=0 F S H=$O(^DIC(40.7,"B",SDSVSP,H)) Q:H="" D Q:SDSCN'=0 "RTN","SDEC50",384,0) ..I $P(^DIC(40.7,H,0),U,3)'="",$P(^DIC(40.7,H,0),U,3)<$$NOW^XLFDT() Q "RTN","SDEC50",385,0) ..S SDSCN=H "RTN","SDEC50",386,0) I '+SDSCN D ERR1^SDECERR(-1,"Invalid Service/Specialty.",SDECI,SDECY) Q "RTN","SDEC50",387,0) S SDCL=0 F S SDCL=$O(^SC(SDCL)) Q:SDCL'>0 D "RTN","SDEC50",388,0) .S SDCLN=$P($G(^SC(SDCL,0)),U,7) "RTN","SDEC50",389,0) .I $$GET1^DIQ(44,SDCL_",",2505,)'="",$$GET1^DIQ(44,SDCL_",",2506)="" Q ;only active "RTN","SDEC50",390,0) .I SDCLN=SDSCN S SDECI=SDECI+1 S @SDECY@(SDECI)=SDSCN_U_SDCL_U_$P($G(^SC(SDCL,0)),U,1)_$C(30) "RTN","SDEC50",391,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDEC50",392,0) Q "RTN","SDEC55A") 0^3^B89324584^B88296381 "RTN","SDEC55A",1,0) SDEC55A ;ALB/SAT - VISTA SCHEDULING RPCS ; 18 Jun 2018 4:04 PM "RTN","SDEC55A",2,0) ;;5.3;Scheduling;**627,671,701,722**;Aug 13, 1993;Build 26 "RTN","SDEC55A",3,0) ; "RTN","SDEC55A",4,0) Q "RTN","SDEC55A",5,0) ; "RTN","SDEC55A",6,0) APPSDGET(SDECY,MAXREC,LASTSUB,SDBEG,SDEND,NOTEFLG,SDRES,DFN,SDID,SDIEN) ;GET appointment data from SDEC APPOINTMENT file 409.84 "RTN","SDEC55A",7,0) ;APPSDGET(.SDECY,MAXREC,LASTSUB,SDBEG,SDEND,NOTEFLG,SDRES,DFN,SDID,SDIEN) external parameter tag is in SDEC "RTN","SDEC55A",8,0) ;INPUT: "RTN","SDEC55A",9,0) ; 1. MAXREC = (optional) Max records returned default to all "RTN","SDEC55A",10,0) ; 2. LASTSUB = (optional) last subscripts from previous call "RTN","SDEC55A",11,0) ; 3. SDBEG = (optional) Begin Date range in external format "RTN","SDEC55A",12,0) ; Default to all dates "RTN","SDEC55A",13,0) ; 4. SDEND = (optional) End Date range in external format "RTN","SDEC55A",14,0) ; Default to all dates "RTN","SDEC55A",15,0) ; 5. NOTEFLG = (optional) 1=do NOT return NOTE text "RTN","SDEC55A",16,0) ; 0=return NOTE text "RTN","SDEC55A",17,0) ; 6. SDRES = (optional) Resource ID pointer to SDEC RESOURCE file "RTN","SDEC55A",18,0) ; Default to all resources "RTN","SDEC55A",19,0) ; 7. DFN = (optional) pointer to PATIENT file 2 "RTN","SDEC55A",20,0) ; Default to all patients "RTN","SDEC55A",21,0) ; 8. SDID = (optional) external ID (free-text) "RTN","SDEC55A",22,0) ; Default to all external IDs "RTN","SDEC55A",23,0) ; 9. SDIEN = (optional) pointer to SDEC APPOINTMENT file 409.84 "RTN","SDEC55A",24,0) ;RETURN: "RTN","SDEC55A",25,0) ; Successful Return: "RTN","SDEC55A",26,0) ; Global Array in which each array entry contains data from the "RTN","SDEC55A",27,0) ; SDEC APPOINTMENT file 409.84. "RTN","SDEC55A",28,0) ; Data is separated by ^: "RTN","SDEC55A",29,0) ; 1. IEN - pointer to SDEC APPOINTMENT file "RTN","SDEC55A",30,0) ; 2. DATE1 - STARTTIME in external format .01 "RTN","SDEC55A",31,0) ; 3. DATE2 - ENDTIME in external format .02 "RTN","SDEC55A",32,0) ; 4. CHECKIN_TIME - CHECKIN date/time in external format .03 "RTN","SDEC55A",33,0) ; 5. DATE - CHECK IN TIME ENTERED - date/time in external format .04 "RTN","SDEC55A",34,0) ; 6. DFN - Patient ID .05 "RTN","SDEC55A",35,0) ; 7. NAME - Patient NAME .05 "RTN","SDEC55A",36,0) ; 8. SDEC_ACCESS_TYPE_IEN - "RTN","SDEC55A",37,0) ; 9. SDEC_ACCESS_TYPE_NAME - "RTN","SDEC55A",38,0) ; 10. RESOURCEID - Pointer to the SDEC RESOURCE file "RTN","SDEC55A",39,0) ; 11. RESOURCE_NAME - NAME from SDEC RESOURCE file "RTN","SDEC55A",40,0) ; 12. USERIEN - DATA ENTRY CLERK id pointer to NEW PERSON file "RTN","SDEC55A",41,0) ; 13. USERNAME - DATA ENTRY CLERK name from NEW PERSON file "RTN","SDEC55A",42,0) ; 14. DATE3 - DATE APPT MADE in external format "RTN","SDEC55A",43,0) ; 15. NOSHOW - NOSHOW flag 1=YES; 0=NO default to no "RTN","SDEC55A",44,0) ; 16. DATE4 - NOSHOW DATETIME in external format "RTN","SDEC55A",45,0) ; 17. USERIEN1 - NOSHOW BY USER id pointer to NEW PERSON file "RTN","SDEC55A",46,0) ; 18. USERNAME1 - NOSHOW BY USER name from NEW PERSON file "RTN","SDEC55A",47,0) ; 19. DATE5 - REBOOK DATETIME in external format "RTN","SDEC55A",48,0) ; 20. DATE6 - CANCEL DATETIME in external format "RTN","SDEC55A",49,0) ; 21. USERIEN2 - CANCELLED BY USER id pointer to NEW PERSON file "RTN","SDEC55A",50,0) ; 22. USERNAME2 - CANCELLED BY USER name from NEW PERSON file "RTN","SDEC55A",51,0) ; 23. CANCELLATION_REASONS_IEN - CANCELLATION REASON id pointer "RTN","SDEC55A",52,0) ; to CANCELLATION REASONS file 409.2 "RTN","SDEC55A",53,0) ; 24. CANCELLATION_REASONS_NAME - CANCELLATION REASON name from "RTN","SDEC55A",54,0) ; CANCELLATION REASONS file "RTN","SDEC55A",55,0) ; 25. WALKIN - WALKIN flag y=YES; n=NO default to NO "RTN","SDEC55A",56,0) ; 26. CHECKOUT - CHECKOUT date/time in external format "RTN","SDEC55A",57,0) ; 27. V_PROVIDER_IEN - V PROVIDER IEN id pointer to "RTN","SDEC55A",58,0) ; V PROVIDER file "RTN","SDEC55A",59,0) ; 28. V_PROVIDER_NAME - V PROVIDER name from V PROVIDER FILE "RTN","SDEC55A",60,0) ; 29. PROVIEN - PROVIDER id pointer to NEW PERSON file "RTN","SDEC55A",61,0) ; 30. PROVNAME - PROVIDER name from NEW PERSON file "RTN","SDEC55A",62,0) ; 31. STATUS - STATUS set of codes "RTN","SDEC55A",63,0) ; valid values in external form are: "RTN","SDEC55A",64,0) ; NO-SHOW "RTN","SDEC55A",65,0) ; CLINIC "RTN","SDEC55A",66,0) ; NO-SHOW & AUTO RE-BOOK "RTN","SDEC55A",67,0) ; CANCELLED BY CLINIC & AUTO RE-BOOK "RTN","SDEC55A",68,0) ; INPATIENT APPOINTMENT "RTN","SDEC55A",69,0) ; CANCELLED BY PATIENT "RTN","SDEC55A",70,0) ; CANCELLED BY PATIENT & AUTO-REBOOK "RTN","SDEC55A",71,0) ; NO ACTION TAKEN "RTN","SDEC55A",72,0) ; 32. APPTLEN - LENGTH OF APPT numeric 5-120 "RTN","SDEC55A",73,0) ; 33. APPT_STAT_IEN - PREV APPT STATUS id pointer to "RTN","SDEC55A",74,0) ; APPOINTMENT STATUS file 409.63 "RTN","SDEC55A",75,0) ; 34. APPT_STAT_NAME - PREV APPT STATUS name from "RTN","SDEC55A",76,0) ; APPOINTMENT STATUS file "RTN","SDEC55A",77,0) ; 35. DAPTDT - DESIRED DATE OF APPOINTMENT in external format "RTN","SDEC55A",78,0) ; 36. SDID - EXTERNAL ID free-text "RTN","SDEC55A",79,0) ; 37. SDAPTYP - APPT REQUEST TYPE - variable pointer pointer "RTN","SDEC55A",80,0) ; to one of these files: "RTN","SDEC55A",81,0) ; SD WAIT LIST - E| E|123 "RTN","SDEC55A",82,0) ; REQUEST/CONSULTATION - C| C|123 "RTN","SDEC55A",83,0) ; RECALL REMINDERS - R|^ R|123 "RTN","SDEC55A",84,0) ; 38. NOTE - NOTE free-text converted from Word Processing "RTN","SDEC55A",85,0) ; field. May contain Carriage return/line feed "RTN","SDEC55A",86,0) ; characters "RTN","SDEC55A",87,0) ; 39. EESTAT - Patient Status N=NEW E=ESTABLISHED "RTN","SDEC55A",88,0) ; 40. APPTTYPE_IEN - pointer to the APPOINTMENT TYPE file "RTN","SDEC55A",89,0) ; 41. APPTTYPE_NAME - name from the APPOINTMENT TYPE file "RTN","SDEC55A",90,0) ; "RTN","SDEC55A",91,0) N SD1,SD2,SDAPP,SDECI,SDI,SDJ,SDTMP,X,Y,%DT "RTN","SDEC55A",92,0) S SDECY="^TMP(""SDEC55A"","_$J_",""APPSDGET"")" "RTN","SDEC55A",93,0) K @SDECY "RTN","SDEC55A",94,0) S SDECI=0 "RTN","SDEC55A",95,0) ; 1 2 3 4 5 6 7 "RTN","SDEC55A",96,0) S SDTMP="T00030IEN^T00030DATE1^T00030DATE2^T00030CHECKIN_TIME^T00030DATE^T00030DFN^T00030NAME" "RTN","SDEC55A",97,0) ; 8 9 10 11 "RTN","SDEC55A",98,0) S SDTMP=SDTMP_"^T00030SDEC_ACCESS_TYPE_IEN^T00030SDEC_ACCESS_TYPE_NAME^T00030RESOURCEID^T00030RESOURCE_NAME" "RTN","SDEC55A",99,0) ; 12 13 14 15 16 17 18 "RTN","SDEC55A",100,0) S SDTMP=SDTMP_"^T00030USERIEN^T00030USERNAME^T00030DATE3^T00030NOSHOW^T00030DATE4^T00030USERIEN1^T00030USERNAME1" "RTN","SDEC55A",101,0) ; 19 20 21 22 23 "RTN","SDEC55A",102,0) S SDTMP=SDTMP_"^T00030DATE5^T00030DATE6^T00030USERIEN2^T00030USERNAME2^T00030CANCELLATION_REASONS_IEN" "RTN","SDEC55A",103,0) ; 24 25 26 27 28 "RTN","SDEC55A",104,0) S SDTMP=SDTMP_"^T00030CANCELLATION_REASONS_NAME^T00030WALKIN^T00030CHECKOUT^T00030V_PROVIDER_IEN^T00030V_PROVIDER_NAME" "RTN","SDEC55A",105,0) ; 29 30 31 32 33 34 "RTN","SDEC55A",106,0) S SDTMP=SDTMP_"^T00030PROVIEN^T00030PROVNAME^T00030STATUS^T00030APPTLEN^T00030APPT_STAT_IEN^T00030APPT_STAT_NAME" "RTN","SDEC55A",107,0) ; 35 36 37 38 "RTN","SDEC55A",108,0) S SDTMP=SDTMP_"^T00030DAPTDT^T00030SDID^T00030SDAPTYP^T00200NOTE^T00030EESTAT^T00030APPTTYPE_IEN^T00030APPTTYPE_NAME" "RTN","SDEC55A",109,0) S @SDECY@(SDECI)=SDTMP_$C(30) "RTN","SDEC55A",110,0) ;*zeb+1 722 1/9/19 prevent giant loop on bad data "RTN","SDEC55A",111,0) I $G(SDIEN)_$G(DFN)_$G(SDRES)="" G GETX "RTN","SDEC55A",112,0) ;validate MAXREC - optional "RTN","SDEC55A",113,0) S MAXREC=$G(MAXREC) "RTN","SDEC55A",114,0) I MAXREC'="" I '+MAXREC S MAXREC="" "RTN","SDEC55A",115,0) ;validate LASTSUB - optional "RTN","SDEC55A",116,0) S LASTSUB=$G(LASTSUB) "RTN","SDEC55A",117,0) S SD1=$P(LASTSUB,"|",1),SD2=$P(LASTSUB,"|",2) "RTN","SDEC55A",118,0) I SD2'="" I SDID="" S SD1=SD1-.0001 "RTN","SDEC55A",119,0) ;validate SDBEG - optional "RTN","SDEC55A",120,0) S SDBEG=$G(SDBEG) "RTN","SDEC55A",121,0) I $G(SDBEG)'="" S %DT="" S X=$P($G(SDBEG),"@",1) D ^%DT S SDBEG=Y I Y=-1 D ERR1^SDECERR(-1,"Invalid begin date/time.",SDECI,SDECY) Q "RTN","SDEC55A",122,0) I SDBEG'="",SDBEG<$$FMADD^XLFDT($$NOW^XLFDT(),-10*365) D ERR1^SDECERR(-1,"Invalid begin date/time.",SDECI,SDECY) Q ; "RTN","SDEC55A",123,0) ; "RTN","SDEC55A",124,0) ; Limit search to start 10 years ago. wtc 6/18/18 SD*5.3*701 "RTN","SDEC55A",125,0) ; "RTN","SDEC55A",126,0) I SDBEG="" S SDBEG=$$FMADD^XLFDT($$NOW^XLFDT(),-10*365) ; "RTN","SDEC55A",127,0) ; "RTN","SDEC55A",128,0) ;I SDBEG="" S SDBEG=1000101 "RTN","SDEC55A",129,0) ;validate SDEND - optional "RTN","SDEC55A",130,0) S SDEND=$G(SDEND) "RTN","SDEC55A",131,0) I $G(SDEND)'="" S %DT="" S X=$P($G(SDEND),"@",1) D ^%DT S SDEND=Y_".2359" I Y=-1 D ERR1^SDECERR(-1,"Invalid end date/time.",SDECI,SDECY) Q "RTN","SDEC55A",132,0) I SDEND'="",SDEND>$$FMADD^XLFDT($$NOW^XLFDT(),390) D ERR1^SDECERR(-1,"Invalid end date/time.",SDECI,SDECY) Q ; "RTN","SDEC55A",133,0) ; "RTN","SDEC55A",134,0) ; Limit search to no later than 390 days in the future. wtc 6/18/18 SD*5.3*701 "RTN","SDEC55A",135,0) ; "RTN","SDEC55A",136,0) I SDEND="" S SDEND=$P($$FMADD^XLFDT($$NOW^XLFDT(),390),".",1)_".2359" ; "RTN","SDEC55A",137,0) ; "RTN","SDEC55A",138,0) ;I SDEND="" S SDEND=9991231.2359 "RTN","SDEC55A",139,0) ;validate NOTEFLG - optional "RTN","SDEC55A",140,0) S NOTEFLG=$S($G(NOTEFLG)=1:1,1:0) "RTN","SDEC55A",141,0) ;validate SDRES -optional "RTN","SDEC55A",142,0) S SDRES=$G(SDRES) "RTN","SDEC55A",143,0) I SDRES'="" I '$D(^SDEC(409.831,SDRES,0)) D ERR1^SDECERR(-1,"Invalid resource ID.",SDECI,SDECY) Q "RTN","SDEC55A",144,0) ;validate DFN -optional "RTN","SDEC55A",145,0) S DFN=$G(DFN) "RTN","SDEC55A",146,0) I DFN'="" I '$D(^DPT(DFN,0)) D ERR1^SDECERR(-1,"Invalid patient ID.",SDECI,SDECY) Q "RTN","SDEC55A",147,0) ;validate SDID - optional "RTN","SDEC55A",148,0) S SDID=$G(SDID) "RTN","SDEC55A",149,0) ;validate SDIEN - optional "RTN","SDEC55A",150,0) S SDIEN=$G(SDIEN) "RTN","SDEC55A",151,0) I SDIEN'="",'$D(^SDEC(409.84,SDIEN,0)) D ERR1^SDECERR(-1,"Invalid ID.",SDECI,SDECY) Q "RTN","SDEC55A",152,0) I SDIEN'="" D GET1(SDIEN,SDBEG,SDEND,NOTEFLG,SDRES,DFN,SDID,.SDECI,SDECY) "RTN","SDEC55A",153,0) G:SDIEN'="" GETX "RTN","SDEC55A",154,0) ;look in external id xref AEX "RTN","SDEC55A",155,0) I SDID'="" D "RTN","SDEC55A",156,0) .S SDAPP=$S(SD1'="":SD1,1:0) F S SDAPP=$O(^SDEC(409.84,"AEX",SDID,SDAPP)) Q:SDAPP'>0 D I +MAXREC,SDECI>=MAXREC S LASTSUB=SDAPP Q "RTN","SDEC55A",157,0) ..D GET1(SDAPP,SDBEG,SDEND,NOTEFLG,SDRES,DFN,SDID,.SDECI,SDECY) "RTN","SDEC55A",158,0) G:SDID'="" GETX "RTN","SDEC55A",159,0) ;look in patient xref CPAT "RTN","SDEC55A",160,0) I DFN'="" D "RTN","SDEC55A",161,0) .S SDAPP=$S(SD1'="":SD1,1:0) F S SDAPP=$O(^SDEC(409.84,"CPAT",DFN,SDAPP)) Q:SDAPP'>0 D I +MAXREC,SDECI>=MAXREC S LASTSUB=SDAPP Q "RTN","SDEC55A",162,0) ..D GET1(SDAPP,SDBEG,SDEND,NOTEFLG,SDRES,DFN,SDID,.SDECI,SDECY) "RTN","SDEC55A",163,0) G:DFN'="" GETX "RTN","SDEC55A",164,0) ;look in resource xref ARSRC "RTN","SDEC55A",165,0) I SDRES'="" D "RTN","SDEC55A",166,0) .S SDI=$S(SD1'="":SD1,1:SDBEG) F S SDI=$O(^SDEC(409.84,"ARSRC",SDRES,SDI)) Q:SDI'>0 Q:SDI>SDEND D I +MAXREC,SDECI>=MAXREC S LASTSUB=SDI_"|"_SDAPP Q "RTN","SDEC55A",167,0) ..S SDAPP=$S(SD2'="":SD2,1:0) S SD2=0 F S SDAPP=$O(^SDEC(409.84,"ARSRC",SDRES,SDI,SDAPP)) Q:SDAPP'>0 D I +MAXREC,SDECI>=MAXREC S LASTSUB=SDI_"|"_SDAPP Q "RTN","SDEC55A",168,0) ...D GET1(SDAPP,SDBEG,SDEND,NOTEFLG,SDRES,DFN,SDID,.SDECI,SDECY) "RTN","SDEC55A",169,0) G:SDRES'="" GETX "RTN","SDEC55A",170,0) ;look in start time xref B "RTN","SDEC55A",171,0) S SDI=$S(SD1'="":SD1,1:SDBEG) F S SDI=$O(^SDEC(409.84,"B",SDI)) Q:SDI'>0 Q:SDI>SDEND D I +MAXREC,SDECI>=MAXREC S LASTSUB=SDI_"|"_SDAPP Q "RTN","SDEC55A",172,0) .S SDAPP=$S(SD2'="":SD2,1:0) S SD2=0 F S SDAPP=$O(^SDEC(409.84,"B",SDI,SDAPP)) Q:SDAPP'>0 D I +MAXREC,SDECI>=MAXREC S LASTSUB=SDI_"|"_SDAPP Q "RTN","SDEC55A",173,0) ..D GET1(SDAPP,SDBEG,SDEND,NOTEFLG,SDRES,DFN,SDID,.SDECI,SDECY) "RTN","SDEC55A",174,0) GETX S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDEC55A",175,0) Q "RTN","SDEC55A",176,0) GET1(SDAPP,SDBEG,SDEND,NOTEFLG,SDRES,DFN,SDID,SDECI,SDECY) ;get 1 appointment record "RTN","SDEC55A",177,0) ;INPUT: "RTN","SDEC55A",178,0) ; SDAPP - appointment ID pointer to SDEC APPOINTMENT file 409.84 "RTN","SDEC55A",179,0) N SDA,SDDATA,SDNOTE,SDRET,SDTYP,SDX,SDY "RTN","SDEC55A",180,0) S SDBEG=$G(SDBEG) "RTN","SDEC55A",181,0) S SDEND=$G(SDEND) "RTN","SDEC55A",182,0) S NOTEFLG=$G(NOTEFLG) "RTN","SDEC55A",183,0) S SDRES=$G(SDRES) "RTN","SDEC55A",184,0) S DFN=$G(DFN) "RTN","SDEC55A",185,0) S SDID=$G(SDID) "RTN","SDEC55A",186,0) S SDECI=$G(SDECI) "RTN","SDEC55A",187,0) S SDECY=$G(SDECY) "RTN","SDEC55A",188,0) D GETS^DIQ(409.84,SDAPP_",",".01:.23","IE","SDDATA") "RTN","SDEC55A",189,0) S SDA="SDDATA(409.84,"""_SDAPP_","")" "RTN","SDEC55A",190,0) S $P(SDRET,U,1)=SDAPP ;ien "RTN","SDEC55A",191,0) S $P(SDRET,U,2)=@SDA@(.01,"E") ;start time "RTN","SDEC55A",192,0) Q:(SDBEG'="")&($P(@SDA@(.01,"I"),".",1)<$P(SDBEG,".",1)) "RTN","SDEC55A",193,0) S $P(SDRET,U,3)=@SDA@(.02,"E") ;end time "RTN","SDEC55A",194,0) Q:(SDEND'="")&($P(@SDA@(.02,"I"),".",1)>$P(SDEND,".",1)) "RTN","SDEC55A",195,0) S $P(SDRET,U,4)=@SDA@(.03,"E") ;check in time "RTN","SDEC55A",196,0) S $P(SDRET,U,5)=@SDA@(.04,"E") ;check in time entered "RTN","SDEC55A",197,0) S $P(SDRET,U,6)=@SDA@(.05,"I") ;patient ID "RTN","SDEC55A",198,0) Q:(DFN'="")&($P(SDRET,U,6)'=DFN) "RTN","SDEC55A",199,0) S $P(SDRET,U,7)=@SDA@(.05,"E") ;patient NAME "RTN","SDEC55A",200,0) S ($P(SDRET,U,40),$P(SDRET,U,8))=@SDA@(.06,"I") ;appointment type ID "RTN","SDEC55A",201,0) S ($P(SDRET,U,41),$P(SDRET,U,9))=@SDA@(.06,"E") ;appointment type NAME "RTN","SDEC55A",202,0) S $P(SDRET,U,10)=@SDA@(.07,"I") ;resource ID "RTN","SDEC55A",203,0) Q:(SDRES'="")&($P(SDRET,U,10)'=SDRES) "RTN","SDEC55A",204,0) S $P(SDRET,U,11)=@SDA@(.07,"E") ;resource NAME "RTN","SDEC55A",205,0) S $P(SDRET,U,12)=@SDA@(.08,"I") ;data entry clerk ID "RTN","SDEC55A",206,0) S $P(SDRET,U,13)=@SDA@(.08,"E") ;data entry clerk NAME "RTN","SDEC55A",207,0) S $P(SDRET,U,14)=@SDA@(.09,"E") ;date appointment made "RTN","SDEC55A",208,0) S $P(SDRET,U,15)=@SDA@(.1,"E") ;noshow flag "RTN","SDEC55A",209,0) S $P(SDRET,U,16)=@SDA@(.101,"E") ;no show date time "RTN","SDEC55A",210,0) S $P(SDRET,U,17)=@SDA@(.102,"I") ;no show by user ID "RTN","SDEC55A",211,0) S $P(SDRET,U,18)=@SDA@(.102,"E") ;no show by user NAME "RTN","SDEC55A",212,0) S $P(SDRET,U,19)=@SDA@(.11,"E") ;rebook date time "RTN","SDEC55A",213,0) S $P(SDRET,U,20)=@SDA@(.12,"E") ;cancel date time "RTN","SDEC55A",214,0) S $P(SDRET,U,21)=@SDA@(.121,"I") ;cancelled by user ID "RTN","SDEC55A",215,0) S $P(SDRET,U,22)=@SDA@(.121,"E") ;cancelled by user NAME "RTN","SDEC55A",216,0) S $P(SDRET,U,23)=@SDA@(.122,"I") ;cancellation reason ID "RTN","SDEC55A",217,0) S $P(SDRET,U,24)=@SDA@(.122,"E") ;cancellation reason NAME "RTN","SDEC55A",218,0) S $P(SDRET,U,25)=@SDA@(.13,"E") ;walk-in "RTN","SDEC55A",219,0) S $P(SDRET,U,26)=@SDA@(.14,"E") ;check-out date/time "RTN","SDEC55A",220,0) S $P(SDRET,U,27)=@SDA@(.15,"I") ;v provider ID "RTN","SDEC55A",221,0) S $P(SDRET,U,28)=@SDA@(.15,"E") ;v provider NAME "RTN","SDEC55A",222,0) S $P(SDRET,U,29)=@SDA@(.16,"I") ;provider ID "RTN","SDEC55A",223,0) S $P(SDRET,U,30)=@SDA@(.16,"E") ;provider NAME "RTN","SDEC55A",224,0) S $P(SDRET,U,31)=@SDA@(.17,"E") ;status "RTN","SDEC55A",225,0) S $P(SDRET,U,32)=@SDA@(.18,"E") ;length of appt "RTN","SDEC55A",226,0) S $P(SDRET,U,33)=@SDA@(.19,"I") ;prev appt status ID "RTN","SDEC55A",227,0) S $P(SDRET,U,34)=@SDA@(.19,"E") ;prev appt status NAME "RTN","SDEC55A",228,0) S $P(SDRET,U,35)=@SDA@(.2,"E") ;desired date of appointment "RTN","SDEC55A",229,0) S $P(SDRET,U,36)=@SDA@(.21,"E") ;external id "RTN","SDEC55A",230,0) Q:(SDID'="")&($P(SDRET,U,36)'=SDID) "RTN","SDEC55A",231,0) S SDX=@SDA@(.22,"I") S SDY=$P(SDX,";",2) "RTN","SDEC55A",232,0) S SDTYP=$S(SDY="SDWL(409.3,":"E|",SDY="GMR(123,":"C|",SDY="SD(403.5,":"R|",SDY="SDEC(409.85,":"A|",1:"")_$P(SDX,";",1) ;appt request type "RTN","SDEC55A",233,0) S $P(SDRET,U,37)=SDTYP "RTN","SDEC55A",234,0) ; "RTN","SDEC55A",235,0) N SDECIEN "RTN","SDEC55A",236,0) S SDNOTE="" "RTN","SDEC55A",237,0) I 'NOTEFLG I $D(^SDEC(409.84,SDAPP,1)) D "RTN","SDEC55A",238,0) . S SDECIEN=0 F S SDECIEN=$O(^SDEC(409.84,SDAPP,1,SDECIEN)) Q:'+SDECIEN D "RTN","SDEC55A",239,0) . . S SDNOTE=SDNOTE_$G(^SDEC(409.84,SDAPP,1,SDECIEN,0)) "RTN","SDEC55A",240,0) . . S SDNOTE=SDNOTE_$C(13)_$C(10) "RTN","SDEC55A",241,0) S $P(SDRET,U,38)=SDNOTE "RTN","SDEC55A",242,0) S $P(SDRET,U,39)=@SDA@(.23,"E") ;patient status "RTN","SDEC55A",243,0) S SDECI=SDECI+1 S @SDECY@(SDECI)=SDRET_$C(30) "RTN","SDEC55A",244,0) K SDDATA "RTN","SDEC55A",245,0) Q "VER") 8.0^22.2 "^DD",409.84,409.84,.05,0) PATIENT^P9000001'^AUPNPAT(^0;5^Q "^DD",409.84,409.84,.05,1,0) ^.1 "^DD",409.84,409.84,.05,1,1,0) 409.84^CPAT "^DD",409.84,409.84,.05,1,1,1) S ^SDEC(409.84,"CPAT",$E(X,1,30),DA)="" "^DD",409.84,409.84,.05,1,1,2) K ^SDEC(409.84,"CPAT",$E(X,1,30),DA) "^DD",409.84,409.84,.05,1,1,"%D",0) ^^1^1^3141022^ "^DD",409.84,409.84,.05,1,1,"%D",1,0) This xref is used to look up appointments by Patient. "^DD",409.84,409.84,.05,1,1,"DT") 3140812 "^DD",409.84,409.84,.05,3) Select a patient "^DD",409.84,409.84,.05,21,0) ^.001^1^1^3190110^^ "^DD",409.84,409.84,.05,21,1,0) This is the patient that this appointment is scheduled for. "^DD",409.84,409.84,.05,"DT") 3190110 **END** **END**