Released SD*5.3*797 SEQ #649 Extracted from mail message **KIDS**:SD*5.3*797^ **INSTALL NAME** SD*5.3*797 "BLD",12502,0) SD*5.3*797^SCHEDULING^0^3211008^y "BLD",12502,1,0) ^^35^35^3210927^ "BLD",12502,1,1,0) "BLD",12502,1,2,0) VSE-1431: .NET: Cannot Schedule VVC in VS GUI - Must Schedule in VCM - "BLD",12502,1,3,0) use new RPC returning JSON "BLD",12502,1,4,0) VSE-1434: VistA: SDEC GETVVSMAKEINFO Contains -1 "BLD",12502,1,5,0) VSE-1444: 508 - .NET: Tabbing Incorrect Function on Make PtCSch Request "BLD",12502,1,6,0) VSE-1463: VistA: Create Block and Move RPC "BLD",12502,1,7,0) VSE-1464: VistA: Add "Block and Move" Cancellation Reason "BLD",12502,1,8,0) VSE-1465: .NET: Block and Move context menu "BLD",12502,1,9,0) VSE-1474: .NET: -1 in provider phone number results in provider not "BLD",12502,1,10,0) displaying in search "BLD",12502,1,11,0) VSE-1509: VistA: Create new RPC based on SDEC SEARCH VVS PROVIDERS RPC "BLD",12502,1,12,0) to return JSON "BLD",12502,1,13,0) VSE-1559: VistA: Update SDES RPCs to follow standard naming convention "BLD",12502,1,14,0) VSE-1600: VistA: Research on Disposition Codes "BLD",12502,1,15,0) "BLD",12502,1,16,0) "BLD",12502,1,17,0) ROUTINE: "BLD",12502,1,18,0) ======== "BLD",12502,1,19,0) SDES: VSE-1463 "BLD",12502,1,20,0) SDESBLKANDMOVE: VSE-1463 "BLD",12502,1,21,0) SDESJSON: VSE-1463 "BLD",12502,1,22,0) SDECAR: VSE-1600 "BLD",12502,1,23,0) SDEC797P: VSE-1464 "BLD",12502,1,24,0) "BLD",12502,1,25,0) RPC: "BLD",12502,1,26,0) ==== "BLD",12502,1,27,0) SDEC GETVVSMAKEINFO JSON: VSE-1431, VSE-1434 "BLD",12502,1,28,0) SDEC SEARCH VVS PROVIDERS JSON: VSE-1474, VSE-1509 "BLD",12502,1,29,0) SDES MAKE APPT BLOCK AND MOVE: VSE-1463 "BLD",12502,1,30,0) SDES SEARCH CLINIC "BLD",12502,1,31,0) "BLD",12502,1,32,0) OPTION: "BLD",12502,1,33,0) ======= "BLD",12502,1,34,0) SDECRPC: VSE-1434, VSE-1474, VSE-1509, VSE-1559 "BLD",12502,1,35,0) SDESRPC: VSE-1463 "BLD",12502,4,0) ^9.64PA^^ "BLD",12502,6) 6^ "BLD",12502,6.3) 8 "BLD",12502,"ABPKG") n "BLD",12502,"INIT") SDEC797P "BLD",12502,"KRN",0) ^9.67PA^1.5^24 "BLD",12502,"KRN",.4,0) .4 "BLD",12502,"KRN",.401,0) .401 "BLD",12502,"KRN",.402,0) .402 "BLD",12502,"KRN",.403,0) .403 "BLD",12502,"KRN",.5,0) .5 "BLD",12502,"KRN",.84,0) .84 "BLD",12502,"KRN",1.5,0) 1.5 "BLD",12502,"KRN",1.6,0) 1.6 "BLD",12502,"KRN",1.61,0) 1.61 "BLD",12502,"KRN",1.62,0) 1.62 "BLD",12502,"KRN",3.6,0) 3.6 "BLD",12502,"KRN",3.8,0) 3.8 "BLD",12502,"KRN",9.2,0) 9.2 "BLD",12502,"KRN",9.8,0) 9.8 "BLD",12502,"KRN",9.8,"NM",0) ^9.68A^11^11 "BLD",12502,"KRN",9.8,"NM",1,0) SDES^^0^B17156529 "BLD",12502,"KRN",9.8,"NM",2,0) SDESJSON^^0^B28507962 "BLD",12502,"KRN",9.8,"NM",3,0) SDESBLKANDMOVE^^0^B162734102 "BLD",12502,"KRN",9.8,"NM",4,0) SDECAR^^0^B93128026 "BLD",12502,"KRN",9.8,"NM",5,0) SDEC1^^0^B12073914 "BLD",12502,"KRN",9.8,"NM",6,0) SDECVVSJSON^^0^B14869168 "BLD",12502,"KRN",9.8,"NM",7,0) SDECPRVSRCHJSON^^0^B7828205 "BLD",12502,"KRN",9.8,"NM",8,0) SDEC08^^0^B182181620 "BLD",12502,"KRN",9.8,"NM",9,0) SDEC32^^0^B127199073 "BLD",12502,"KRN",9.8,"NM",10,0) SDEC52B^^0^B22077700 "BLD",12502,"KRN",9.8,"NM",11,0) SDM0^^0^B107738621 "BLD",12502,"KRN",9.8,"NM","B","SDEC08",8) "BLD",12502,"KRN",9.8,"NM","B","SDEC1",5) "BLD",12502,"KRN",9.8,"NM","B","SDEC32",9) "BLD",12502,"KRN",9.8,"NM","B","SDEC52B",10) "BLD",12502,"KRN",9.8,"NM","B","SDECAR",4) "BLD",12502,"KRN",9.8,"NM","B","SDECPRVSRCHJSON",7) "BLD",12502,"KRN",9.8,"NM","B","SDECVVSJSON",6) "BLD",12502,"KRN",9.8,"NM","B","SDES",1) "BLD",12502,"KRN",9.8,"NM","B","SDESBLKANDMOVE",3) "BLD",12502,"KRN",9.8,"NM","B","SDESJSON",2) "BLD",12502,"KRN",9.8,"NM","B","SDM0",11) "BLD",12502,"KRN",19,0) 19 "BLD",12502,"KRN",19,"NM",0) ^9.68A^2^2 "BLD",12502,"KRN",19,"NM",1,0) SDECRPC^^0 "BLD",12502,"KRN",19,"NM",2,0) SDESRPC^^0 "BLD",12502,"KRN",19,"NM","B","SDECRPC",1) "BLD",12502,"KRN",19,"NM","B","SDESRPC",2) "BLD",12502,"KRN",19.1,0) 19.1 "BLD",12502,"KRN",101,0) 101 "BLD",12502,"KRN",409.61,0) 409.61 "BLD",12502,"KRN",771,0) 771 "BLD",12502,"KRN",779.2,0) 779.2 "BLD",12502,"KRN",870,0) 870 "BLD",12502,"KRN",8989.51,0) 8989.51 "BLD",12502,"KRN",8989.52,0) 8989.52 "BLD",12502,"KRN",8994,0) 8994 "BLD",12502,"KRN",8994,"NM",0) ^9.68A^4^4 "BLD",12502,"KRN",8994,"NM",1,0) SDES SEARCH CLINIC^^0 "BLD",12502,"KRN",8994,"NM",2,0) SDES MAKE APPT BLOCK AND MOVE^^0 "BLD",12502,"KRN",8994,"NM",3,0) SDEC SEARCH VVS PROVIDERS JSON^^0 "BLD",12502,"KRN",8994,"NM",4,0) SDEC GETVVSMAKEINFO JSON^^0 "BLD",12502,"KRN",8994,"NM","B","SDEC GETVVSMAKEINFO JSON",4) "BLD",12502,"KRN",8994,"NM","B","SDEC SEARCH VVS PROVIDERS JSON",3) "BLD",12502,"KRN",8994,"NM","B","SDES MAKE APPT BLOCK AND MOVE",2) "BLD",12502,"KRN",8994,"NM","B","SDES SEARCH CLINIC",1) "BLD",12502,"KRN","B",.4,.4) "BLD",12502,"KRN","B",.401,.401) "BLD",12502,"KRN","B",.402,.402) "BLD",12502,"KRN","B",.403,.403) "BLD",12502,"KRN","B",.5,.5) "BLD",12502,"KRN","B",.84,.84) "BLD",12502,"KRN","B",1.5,1.5) "BLD",12502,"KRN","B",1.6,1.6) "BLD",12502,"KRN","B",1.61,1.61) "BLD",12502,"KRN","B",1.62,1.62) "BLD",12502,"KRN","B",3.6,3.6) "BLD",12502,"KRN","B",3.8,3.8) "BLD",12502,"KRN","B",9.2,9.2) "BLD",12502,"KRN","B",9.8,9.8) "BLD",12502,"KRN","B",19,19) "BLD",12502,"KRN","B",19.1,19.1) "BLD",12502,"KRN","B",101,101) "BLD",12502,"KRN","B",409.61,409.61) "BLD",12502,"KRN","B",771,771) "BLD",12502,"KRN","B",779.2,779.2) "BLD",12502,"KRN","B",870,870) "BLD",12502,"KRN","B",8989.51,8989.51) "BLD",12502,"KRN","B",8989.52,8989.52) "BLD",12502,"KRN","B",8994,8994) "BLD",12502,"QUES",0) ^9.62^^ "BLD",12502,"REQB",0) ^9.611^3^2 "BLD",12502,"REQB",2,0) SD*5.3*794^1 "BLD",12502,"REQB",3,0) SD*5.3*796^1 "BLD",12502,"REQB","B","SD*5.3*794",2) "BLD",12502,"REQB","B","SD*5.3*796",3) "INIT") SDEC797P "KRN",19,2922543,-1) 0^1 "KRN",19,2922543,0) SDECRPC^CLINICAL SCHEDULING PROCEDURE CALLS^^B^^^^^^^^SCHEDULING^y "KRN",19,2922543,1,0) ^19.06^2^2^3210914^^^^ "KRN",19,2922543,1,1,0) This option hosts RPCs in the SDEC namespace. CLINICAL SCHEDULING users "KRN",19,2922543,1,2,0) must have access to this option in order to use CLINICAL SCHEDULING. "KRN",19,2922543,99.1) 65967,43385 "KRN",19,2922543,"RPC",0) ^19.05P^266^266 "KRN",19,2922543,"RPC",1,0) SDEC ACCGPTYG "KRN",19,2922543,"RPC",2,0) SDEC ACCGROUP "KRN",19,2922543,"RPC",3,0) SDEC ACCTYPE "KRN",19,2922543,"RPC",4,0) SDEC ADDACCG "KRN",19,2922543,"RPC",5,0) SDEC ADDACCTY "KRN",19,2922543,"RPC",6,0) SDEC ADDAGI "KRN",19,2922543,"RPC",7,0) SDEC ADDRES "KRN",19,2922543,"RPC",8,0) SDEC ADDRESU "KRN",19,2922543,"RPC",9,0) SDEC ADDRG "KRN",19,2922543,"RPC",10,0) SDEC ADDRGI "KRN",19,2922543,"RPC",12,0) SDEC APBLKOV "KRN",19,2922543,"RPC",13,0) SDEC APPADD "KRN",19,2922543,"RPC",13,1) "KRN",19,2922543,"RPC",14,0) SDEC APPDEL "KRN",19,2922543,"RPC",16,0) SDEC APPTLETR "KRN",19,2922543,"RPC",17,0) SDEC APPTYPES "KRN",19,2922543,"RPC",18,0) SDEC AVADD "KRN",19,2922543,"RPC",19,0) SDEC AVDEL "KRN",19,2922543,"RPC",20,0) SDEC AVDELDT "KRN",19,2922543,"RPC",21,0) SDEC CANCKOUT "KRN",19,2922543,"RPC",22,0) SDEC CANREAS "KRN",19,2922543,"RPC",23,0) SDEC CHECKIN "KRN",19,2922543,"RPC",24,0) SDEC CHECKOUT "KRN",19,2922543,"RPC",25,0) SDEC CLINALL "KRN",19,2922543,"RPC",27,0) SDEC CLINDIS "KRN",19,2922543,"RPC",28,0) SDEC CLINDISW "KRN",19,2922543,"RPC",29,0) SDEC CLINLET "KRN",19,2922543,"RPC",30,0) SDEC CLINLETW "KRN",19,2922543,"RPC",31,0) SDEC CLINPROV "KRN",19,2922543,"RPC",32,0) SDEC CLINSET "KRN",19,2922543,"RPC",33,0) SDEC CLINSTOP "KRN",19,2922543,"RPC",34,0) SDEC COPYAPPT "KRN",19,2922543,"RPC",35,0) SDEC CPCANC "KRN",19,2922543,"RPC",36,0) SDEC CPSTAT "KRN",19,2922543,"RPC",37,0) SDEC CRSCHED "KRN",19,2922543,"RPC",38,0) SDEC CSLOTSCH "KRN",19,2922543,"RPC",39,0) SDEC CURFACG "KRN",19,2922543,"RPC",40,0) SDEC CVARAPPT "KRN",19,2922543,"RPC",41,0) SDEC DELAG "KRN",19,2922543,"RPC",42,0) SDEC DELAGI "KRN",19,2922543,"RPC",43,0) SDEC DELRESGP "KRN",19,2922543,"RPC",44,0) SDEC DELRGI "KRN",19,2922543,"RPC",45,0) SDEC DELRU "KRN",19,2922543,"RPC",46,0) SDEC EDITAPPT "KRN",19,2922543,"RPC",47,0) SDEC EHRPT "KRN",19,2922543,"RPC",48,0) SDEC GETFAC "KRN",19,2922543,"RPC",49,0) SDEC GETREGA "KRN",19,2922543,"RPC",50,0) SDEC HLTHSUMM "KRN",19,2922543,"RPC",51,0) SDEC HOLIDAY "KRN",19,2922543,"RPC",52,0) SDEC HOSPLOC "KRN",19,2922543,"RPC",53,0) SDEC IMHERE "KRN",19,2922543,"RPC",54,0) SDEC NEWPERS "KRN",19,2922543,"RPC",55,0) SDEC NOSHOPAT "KRN",19,2922543,"RPC",56,0) SDEC NOSHOW "KRN",19,2922543,"RPC",57,0) SDEC OVBOOK "KRN",19,2922543,"RPC",58,0) SDEC PATAPPTD "KRN",19,2922543,"RPC",59,0) SDEC PATAPPTH "KRN",19,2922543,"RPC",60,0) SDEC PROVALL "KRN",19,2922543,"RPC",61,0) SDEC PROVCLIN "KRN",19,2922543,"RPC",62,0) SDEC PTLOOKRS "KRN",19,2922543,"RPC",63,0) SDEC PWH "KRN",19,2922543,"RPC",64,0) SDEC RAISEVNT "KRN",19,2922543,"RPC",66,0) SDEC REBKLIST "KRN",19,2922543,"RPC",67,0) SDEC REBKNEXT "KRN",19,2922543,"RPC",68,0) SDEC REGEVENT "KRN",19,2922543,"RPC",69,0) SDEC RESGPUSR "KRN",19,2922543,"RPC",70,0) SDEC RESGRPUS "KRN",19,2922543,"RPC",71,0) SDEC RESLETRF "KRN",19,2922543,"RPC",72,0) SDEC RESLETRS "KRN",19,2922543,"RPC",73,0) SDEC RESOURCE "KRN",19,2922543,"RPC",74,0) SDEC RESUSER "KRN",19,2922543,"RPC",75,0) SDEC SCHUSR "KRN",19,2922543,"RPC",76,0) SDEC SEARCHAV "KRN",19,2922543,"RPC",77,0) SDEC SETFAC "KRN",19,2922543,"RPC",78,0) SDEC SETRBOOK "KRN",19,2922543,"RPC",79,0) SDEC SPACEBAR "KRN",19,2922543,"RPC",80,0) SDEC SUSRINFO "KRN",19,2922543,"RPC",81,0) SDEC SVSPALL "KRN",19,2922543,"RPC",82,0) SDEC SYSSTAT "KRN",19,2922543,"RPC",83,0) SDEC TPBLKOV "KRN",19,2922543,"RPC",85,0) SDEC UNREGEV "KRN",19,2922543,"RPC",86,0) SDEC WAITLIST "KRN",19,2922543,"RPC",87,0) SDEC WLCLOSE "KRN",19,2922543,"RPC",88,0) SDEC WLGET "KRN",19,2922543,"RPC",89,0) SDEC WLSET "KRN",19,2922543,"RPC",90,0) SDEC PREFGET "KRN",19,2922543,"RPC",91,0) SDEC PREFGETV "KRN",19,2922543,"RPC",92,0) SDEC PREFSET "KRN",19,2922543,"RPC",93,0) SDEC FAPPTGET "KRN",19,2922543,"RPC",94,0) SDEC RECAPGET "KRN",19,2922543,"RPC",95,0) SDEC RECDSET "KRN",19,2922543,"RPC",96,0) SDEC RECGET "KRN",19,2922543,"RPC",97,0) SDEC RECPRGET "KRN",19,2922543,"RPC",98,0) SDEC RECSET "KRN",19,2922543,"RPC",99,0) SDEC REQGET "KRN",19,2922543,"RPC",100,0) SDEC PCSTGET "KRN",19,2922543,"RPC",101,0) SDEC PCST2GET "KRN",19,2922543,"RPC",102,0) SDEC PCSGET "KRN",19,2922543,"RPC",103,0) SDEC PTSET "KRN",19,2922543,"RPC",104,0) SDEC PTINQ "KRN",19,2922543,"RPC",106,0) SDEC SUMMAGET "KRN",19,2922543,"RPC",107,0) SDEC APPIDGET "KRN",19,2922543,"RPC",108,0) SDEC FACLIST "KRN",19,2922543,"RPC",109,0) SDEC CGET "KRN",19,2922543,"RPC",110,0) SDEC ETHGET "KRN",19,2922543,"RPC",111,0) SDEC ETHCMGET "KRN",19,2922543,"RPC",112,0) SDEC RACEGET "KRN",19,2922543,"RPC",113,0) SDEC REP1GET "KRN",19,2922543,"RPC",114,0) SDEC WLPCSET "KRN",19,2922543,"RPC",115,0) SDEC APPSDGET "KRN",19,2922543,"RPC",116,0) SDEC WLOPEN "KRN",19,2922543,"RPC",117,0) SDEC ARCLOSE "KRN",19,2922543,"RPC",118,0) SDEC ARDGET "KRN",19,2922543,"RPC",119,0) SDEC ARGET "KRN",19,2922543,"RPC",120,0) SDEC ARMRTGET "KRN",19,2922543,"RPC",121,0) SDEC ARMRTSET "KRN",19,2922543,"RPC",122,0) SDEC AROPEN "KRN",19,2922543,"RPC",123,0) SDEC ARPCSET "KRN",19,2922543,"RPC",124,0) SDEC ARSET "KRN",19,2922543,"RPC",125,0) SDEC HIDE "KRN",19,2922543,"RPC",126,0) SDEC PRIV "KRN",19,2922543,"RPC",127,0) SDEC WLHIDE "KRN",19,2922543,"RPC",128,0) SDECAR ARAPPT "KRN",19,2922543,"RPC",129,0) SDECAR ARMRTC "KRN",19,2922543,"RPC",130,0) SDECDEV DEVICE "KRN",19,2922543,"RPC",131,0) SDECDIS DISABIL "KRN",19,2922543,"RPC",132,0) SDECIDX GETREC "KRN",19,2922543,"RPC",133,0) SDECIDX RECCNT "KRN",19,2922543,"RPC",134,0) SDECLK LOCK "KRN",19,2922543,"RPC",135,0) SDECLK UNLOCK "KRN",19,2922543,"RPC",136,0) SDECLOC PRIVLOC "KRN",19,2922543,"RPC",137,0) SDECLOC UPDPRIV "KRN",19,2922543,"RPC",138,0) SDECRMG RECCNT "KRN",19,2922543,"RPC",139,0) SDECRMG RMG "KRN",19,2922543,"RPC",140,0) SDECRMG2 URGENCY "KRN",19,2922543,"RPC",141,0) DG SENSITIVE RECORD ACCESS "KRN",19,2922543,"RPC",142,0) DG CHK BS5 XREF ARRAY "KRN",19,2922543,"RPC",143,0) ORPRF HASFLG "KRN",19,2922543,"RPC",144,0) ORPRF GETFLG "KRN",19,2922543,"RPC",145,0) ORWPT DIEDON "KRN",19,2922543,"RPC",146,0) ORWPT ID INFO "KRN",19,2922543,"RPC",147,0) ORWPT LAST5 "KRN",19,2922543,"RPC",148,0) ORWPT LAST5 RPL "KRN",19,2922543,"RPC",149,0) ORWU USERINFO "KRN",19,2922543,"RPC",150,0) SD VSE FILTER RPC "KRN",19,2922543,"RPC",151,0) SD VSE REPORT RPC "KRN",19,2922543,"RPC",152,0) SDEC APPSLOTS "KRN",19,2922543,"RPC",154,0) SDEC NETLOC "KRN",19,2922543,"RPC",155,0) SDEC NOAVAIL "KRN",19,2922543,"RPC",156,0) SDECAPP GETYPE "KRN",19,2922543,"RPC",157,0) SDECAR ARMULT "KRN",19,2922543,"RPC",158,0) SDECAR AUDITGET "KRN",19,2922543,"RPC",159,0) SDECCAP CAN "KRN",19,2922543,"RPC",160,0) SDECCAP GET "KRN",19,2922543,"RPC",161,0) SDECCAP SET "KRN",19,2922543,"RPC",162,0) SDECWL AUDITGET "KRN",19,2922543,"RPC",163,0) ROR LIST STATES "KRN",19,2922543,"RPC",164,0) XUS SIGNON SETUP "KRN",19,2922543,"RPC",165,0) XUS GET VISITOR "KRN",19,2922543,"RPC",166,0) XUS SET VISITOR "KRN",19,2922543,"RPC",167,0) XUS AV CODE "KRN",19,2922543,"RPC",168,0) SDEC01 CLINICS "KRN",19,2922543,"RPC",169,0) SDEC57 OBM "KRN",19,2922543,"RPC",170,0) SDECAR3 AREDIT "KRN",19,2922543,"RPC",171,0) SDECDEM MARITAL "KRN",19,2922543,"RPC",172,0) SDECDEM RELIGION "KRN",19,2922543,"RPC",173,0) SDECDEM ZIPLINK "KRN",19,2922543,"RPC",174,0) SDECDEV DEV "KRN",19,2922543,"RPC",175,0) SDECDEV PRINT "KRN",19,2922543,"RPC",176,0) SDECRMGP GETRMGUP "KRN",19,2922543,"RPC",177,0) SDECRMGP PUTRMGUP "KRN",19,2922543,"RPC",178,0) SDECU4 GETFONT "KRN",19,2922543,"RPC",179,0) SDECU4 PUTFONT "KRN",19,2922543,"RPC",180,0) ORWU CLINLOC "KRN",19,2922543,"RPC",181,0) XUS GET USER INFO "KRN",19,2922543,"RPC",182,0) XUS GET CCOW TOKEN "KRN",19,2922543,"RPC",183,0) ORWPT SHARE "KRN",19,2922543,"RPC",184,0) ORWPT TOP "KRN",19,2922543,"RPC",185,0) DG SENSITIVE RECORD BULLETIN "KRN",19,2922543,"RPC",186,0) SDEC EP CLASSIFICATION "KRN",19,2922543,"RPC",187,0) SDEC EP CPT "KRN",19,2922543,"RPC",188,0) SDEC EP DEMOGRAPHICS "KRN",19,2922543,"RPC",189,0) SDEC EP DIAGNOSIS "KRN",19,2922543,"RPC",190,0) SDEC EP EVENT LOG "KRN",19,2922543,"RPC",191,0) SDEC EP PROVIDER "KRN",19,2922543,"RPC",192,0) SDEC EP PT INFO "KRN",19,2922543,"RPC",193,0) SDEC EP STOP CODE "KRN",19,2922543,"RPC",194,0) SDEC EP WAIT TIME "KRN",19,2922543,"RPC",195,0) SDEC APPT STATUS "KRN",19,2922543,"RPC",196,0) SDEC ELIGIBILITY "KRN",19,2922543,"RPC",197,0) SDEC CONTACT DISPLAY "KRN",19,2922543,"RPC",198,0) SDEC CONTACT MULTI-DISPLAY "KRN",19,2922543,"RPC",199,0) SDEC CONTACT NEW "KRN",19,2922543,"RPC",200,0) SDEC CONTACT SEQUENCE "KRN",19,2922543,"RPC",201,0) SDEC CONTACT STOP CODE "KRN",19,2922543,"RPC",202,0) SDEC CONTACT UPDATE "KRN",19,2922543,"RPC",203,0) SDEC GETPRER "KRN",19,2922543,"RPC",204,0) SDEC ELIG RETURN "KRN",19,2922543,"RPC",205,0) SDEC BOOKHLDY "KRN",19,2922543,"RPC",206,0) SDECAR1 ARGUID "KRN",19,2922543,"RPC",207,0) SDECSTNG HELPLINK "KRN",19,2922543,"RPC",208,0) XWB GET VARIABLE VALUE "KRN",19,2922543,"RPC",209,0) SDEC RESCE "KRN",19,2922543,"RPC",210,0) SDEC SUMMGET2 "KRN",19,2922543,"RPC",211,0) SDEC CANCMT "KRN",19,2922543,"RPC",212,0) SDEC VVC_APPT "KRN",19,2922543,"RPC",213,0) ORQQCN DETAIL "KRN",19,2922543,"RPC",214,0) SDEC CLINIC GROUP LOOKUP "KRN",19,2922543,"RPC",215,0) SDEC CLINIC GROUP RETURN "KRN",19,2922543,"RPC",216,0) SDEC GETWLIEN "KRN",19,2922543,"RPC",217,0) SDEC CONTACT DISPLAY SINGLE "KRN",19,2922543,"RPC",218,0) SDEC CONTACT SEQUENCE SINGLE "KRN",19,2922543,"RPC",219,0) SDEC GETVVSMAKEINFO "KRN",19,2922543,"RPC",220,0) SDEC SEARCH VVS PROVIDERS "KRN",19,2922543,"RPC",221,0) SDEC SPACEBAR VVS PRO "KRN",19,2922543,"RPC",225,0) SDEC VVS GET ID "KRN",19,2922543,"RPC",226,0) SDEC VVS DELETE ID "KRN",19,2922543,"RPC",227,0) SDEC VVS SAVE ID "KRN",19,2922543,"RPC",229,0) SDEC GET PATIENT APPT REQ "KRN",19,2922543,"RPC",230,0) SDEC GET PATIENT CONSULTS JSON "KRN",19,2922543,"RPC",231,0) SDEC GET PATIENT CONSULTS "KRN",19,2922543,"RPC",232,0) SDEC GET PATIENT RECALLS "KRN",19,2922543,"RPC",233,0) SDEC GET PATIENT APPT REQ JSON "KRN",19,2922543,"RPC",234,0) SDEC GET PATIENT RECALLS JSON "KRN",19,2922543,"RPC",238,0) SDEC GET ICN "KRN",19,2922543,"RPC",239,0) SDEC GET APPT REQ BY IEN JSON "KRN",19,2922543,"RPC",240,0) SDEC GET PATIENT CONSULT JSON "KRN",19,2922543,"RPC",241,0) SDEC GET PATIENT DEMOG "KRN",19,2922543,"RPC",242,0) SDEC GET PATIENT RECALL BY IEN "KRN",19,2922543,"RPC",243,0) SDEC GET RECALL BY IEN JSON "KRN",19,2922543,"RPC",244,0) SDES GET APPT CHECK-IN STEP "KRN",19,2922543,"RPC",245,0) SDES SET APPT CHECK-IN STEP "KRN",19,2922543,"RPC",246,0) SDES GET APPT CHECK-IN STEPS "KRN",19,2922543,"RPC",247,0) SDES SET CHECK-IN STEP "KRN",19,2922543,"RPC",248,0) SDES EDIT CHECK-IN STEP "KRN",19,2922543,"RPC",249,0) SDES GET CHECK-IN STEPS "KRN",19,2922543,"RPC",250,0) SDES GET CHECK-IN STEP "KRN",19,2922543,"RPC",251,0) SDES GET APPTS BY RESOURCE "KRN",19,2922543,"RPC",252,0) SDES GET APPT "KRN",19,2922543,"RPC",253,0) SDES GET APPTS BY PATIENT "KRN",19,2922543,"RPC",254,0) SDES GET APPTS BY CLINIC "KRN",19,2922543,"RPC",255,0) SDES SEARCH CLINIC "KRN",19,2922543,"RPC",256,0) SDEC GET RECALLRMV BY DFN JSON "KRN",19,2922543,"RPC",257,0) SDES GET INSURANCE VERIFY REQ "KRN",19,2922543,"RPC",258,0) SDES SET APPT REQ CREATE "KRN",19,2922543,"RPC",259,0) SDES SET APPT REQ UPDATE "KRN",19,2922543,"RPC",260,0) SDES DISPOSITION APPT REQ "KRN",19,2922543,"RPC",261,0) SDES GET APPT REQ BY PATIENT "KRN",19,2922543,"RPC",262,0) SDES GET APPT REQ BY IEN "KRN",19,2922543,"RPC",263,0) SDEC SEARCH VVS PROVIDERS "KRN",19,2922543,"RPC",264,0) SDEC GETVVSMAKEINFO "KRN",19,2922543,"RPC",265,0) SDEC SEARCH VVS PROVIDERS JSON "KRN",19,2922543,"RPC",266,0) SDEC GETVVSMAKEINFO JSON "KRN",19,2922543,"U") CLINICAL SCHEDULING PROCEDURE "KRN",19,2922993,-1) 0^2 "KRN",19,2922993,0) SDESRPC^CLINICAL SCHEDULING PROCEDURE CALLS^^B^^^^^^^^ "KRN",19,2922993,1,0) ^^2^2^3210524^ "KRN",19,2922993,1,1,0) This option hosts RPCs in the SDES namespace. CLINICAL SCHEDULING users "KRN",19,2922993,1,2,0) must have access to this option in order to use CLINICAL SCHEDULING. "KRN",19,2922993,"RPC",0) ^19.05P^7^7 "KRN",19,2922993,"RPC",1,0) SDES SEARCH CLINIC "KRN",19,2922993,"RPC",2,0) SDES GET APPT REQ BY IEN "KRN",19,2922993,"RPC",3,0) SDES GET APPT REQ BY PATIENT "KRN",19,2922993,"RPC",4,0) SDES DISPOSITION APPT REQ "KRN",19,2922993,"RPC",5,0) SDES SET APPT REQ CREATE "KRN",19,2922993,"RPC",6,0) SDES SET APPT REQ UPDATE "KRN",19,2922993,"RPC",7,0) SDES MAKE APPT BLOCK AND MOVE "KRN",19,2922993,"U") CLINICAL SCHEDULING PROCEDURE "KRN",8994,5925,-1) 0^1 "KRN",8994,5925,0) SDES SEARCH CLINIC^CLINICRSCSEARCH^SDES^2^R^^^^^^1 "KRN",8994,5925,1,0) ^8994.01^1^1^3210915^^ "KRN",8994,5925,1,1,0) GIVEN A STRING, RETURNS MATCHING CLINIC IENS AND NAMES. "KRN",8994,5925,2,0) ^8994.02A^1^1 "KRN",8994,5925,2,1,0) SEARCHSTRING^1^^1^1 "KRN",8994,5925,2,1,1,0) ^8994.021^1^1^3210915^^ "KRN",8994,5925,2,1,1,1,0) SEARCH STRING TO SEARCH ON "KRN",8994,5925,2,"B","SEARCHSTRING",1) "KRN",8994,5925,2,"PARAMSEQ",1,1) "KRN",8994,5925,3,0) ^8994.03^5^5^3210915^^ "KRN",8994,5925,3,1,0) LIST OF CLINICS IN JSON FORMAT: "KRN",8994,5925,3,2,0) Container: "Resource" "KRN",8994,5925,3,3,0) Properties: "KRN",8994,5925,3,4,0) IEN Calculated/Derived "KRN",8994,5925,3,5,0) Name(E) FILE 44 FIELD .01 "KRN",8994,5926,-1) 0^3 "KRN",8994,5926,0) SDEC SEARCH VVS PROVIDERS JSON^JSONVVSPRVSRCH^SDEC1^2^R "KRN",8994,5926,1,0) ^^2^2^3210914^ "KRN",8994,5926,1,1,0) Search providers and get data needed to make Video Visit Service (VVS) "KRN",8994,5926,1,2,0) Appointment in JSON format. "KRN",8994,5926,2,0) ^8994.02A^1^1 "KRN",8994,5926,2,1,0) SEARCH STRING^1^25^1^1 "KRN",8994,5926,2,"B","SEARCH STRING",1) "KRN",8994,5926,2,"PARAMSEQ",1,1) "KRN",8994,5927,-1) 0^4 "KRN",8994,5927,0) SDEC GETVVSMAKEINFO JSON^JSONVVSMAKEINFO^SDEC1^2^R "KRN",8994,5927,1,0) ^8994.01^2^2^3210914^^ "KRN",8994,5927,1,1,0) Get patient info, default provider info, and system info needed to make a "KRN",8994,5927,1,2,0) Video Visit Service (VVS) appointment in JSON format "KRN",8994,5927,2,0) ^8994.02A^3^2 "KRN",8994,5927,2,2,0) PATIENTIEN^1^20^1^1 "KRN",8994,5927,2,2,1,0) ^^3^3^3210914^ "KRN",8994,5927,2,2,1,1,0) PATIENT IEN JSON "KRN",8994,5927,2,2,1,2,0) "KRN",8994,5927,2,2,1,3,0) Video Visit Service (VVS) appointment IN JSON FORMAT "KRN",8994,5927,2,3,0) CLINICIEN^1^20^1^2 "KRN",8994,5927,2,3,1,0) ^8994.021^5^5^3210915^^ "KRN",8994,5927,2,3,1,1,0) CLINIC IEN JSON "KRN",8994,5927,2,3,1,2,0) RETURN PARAMETER DESCRIPTION: "KRN",8994,5927,2,3,1,3,0) RETURN(1)=PATIENT INFO "KRN",8994,5927,2,3,1,4,0) RETURN(2)=DEFAULT PROVIDER INFO "KRN",8994,5927,2,3,1,5,0) RETURN(3)=SYSTEM INFO "KRN",8994,5927,2,"B","CLINICIEN",3) "KRN",8994,5927,2,"B","PATIENTIEN",2) "KRN",8994,5927,2,"PARAMSEQ",1,2) "KRN",8994,5927,2,"PARAMSEQ",2,3) "KRN",8994,5928,-1) 0^2 "KRN",8994,5928,0) SDES MAKE APPT BLOCK AND MOVE^APPTBLOCKMOVE^SDES^2^R^0^^1^^^1 "KRN",8994,5928,1,0) ^8994.01^3^3^3210923^^ "KRN",8994,5928,1,1,0) APPOINTMENT BLOCK AND MOVE. THIS WILL MOVE AN APPOINTMENT TO A NEW "KRN",8994,5928,1,2,0) CLINIC AND DATE/TIME, CANCEL THE ORIGINAL APPOINTMENT AND KEEP THE "KRN",8994,5928,1,3,0) ORIGINAL SLOT BLOCKED SO IT CAN NOT BE REBOOKED. "KRN",8994,5928,2,0) ^8994.02A^3^3 "KRN",8994,5928,2,1,0) APPTIEN^1^30^1^1 "KRN",8994,5928,2,1,1,0) ^^1^1^3210915^ "KRN",8994,5928,2,1,1,1,0) APPOINTMENT IEN FROM SDEC APPOINTMENT #409.84 "KRN",8994,5928,2,2,0) SDRES^1^30^1^2 "KRN",8994,5928,2,2,1,0) ^^1^1^3210915^ "KRN",8994,5928,2,2,1,1,0) IEN FROM SDEC RESOURCE FILE 409.831 "KRN",8994,5928,2,3,0) APPTDT^1^30^1^3 "KRN",8994,5928,2,3,1,0) ^8994.021^1^1^3210923^^ "KRN",8994,5928,2,3,1,1,0) DATE AND TIME OF NEW APPOINTMENT "KRN",8994,5928,2,"B","APPTDT",3) "KRN",8994,5928,2,"B","APPTIEN",1) "KRN",8994,5928,2,"B","SDRES",2) "KRN",8994,5928,2,"PARAMSEQ",1,1) "KRN",8994,5928,2,"PARAMSEQ",2,2) "KRN",8994,5928,2,"PARAMSEQ",3,3) "MBREQ") 0 "ORD",16,8994) 8994;16;1;;;;RPCE1^XPDIA1;;;RPCDEL^XPDIA1 "ORD",16,8994,0) REMOTE PROCEDURE "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "PKG",16,-1) 1^1 "PKG",16,0) SCHEDULING^SD^APPOINTMENTS,PROFILES,LETTERS,AMIS REPORTS "PKG",16,22,0) ^9.49I^1^1 "PKG",16,22,1,0) 5.3^2930813^2930930 "PKG",16,22,1,"PAH",1,0) 797^3211008^520881803 "PKG",16,22,1,"PAH",1,1,0) ^^35^35^3211008 "PKG",16,22,1,"PAH",1,1,1,0) "PKG",16,22,1,"PAH",1,1,2,0) VSE-1431: .NET: Cannot Schedule VVC in VS GUI - Must Schedule in VCM - "PKG",16,22,1,"PAH",1,1,3,0) use new RPC returning JSON "PKG",16,22,1,"PAH",1,1,4,0) VSE-1434: VistA: SDEC GETVVSMAKEINFO Contains -1 "PKG",16,22,1,"PAH",1,1,5,0) VSE-1444: 508 - .NET: Tabbing Incorrect Function on Make PtCSch Request "PKG",16,22,1,"PAH",1,1,6,0) VSE-1463: VistA: Create Block and Move RPC "PKG",16,22,1,"PAH",1,1,7,0) VSE-1464: VistA: Add "Block and Move" Cancellation Reason "PKG",16,22,1,"PAH",1,1,8,0) VSE-1465: .NET: Block and Move context menu "PKG",16,22,1,"PAH",1,1,9,0) VSE-1474: .NET: -1 in provider phone number results in provider not "PKG",16,22,1,"PAH",1,1,10,0) displaying in search "PKG",16,22,1,"PAH",1,1,11,0) VSE-1509: VistA: Create new RPC based on SDEC SEARCH VVS PROVIDERS RPC "PKG",16,22,1,"PAH",1,1,12,0) to return JSON "PKG",16,22,1,"PAH",1,1,13,0) VSE-1559: VistA: Update SDES RPCs to follow standard naming convention "PKG",16,22,1,"PAH",1,1,14,0) VSE-1600: VistA: Research on Disposition Codes "PKG",16,22,1,"PAH",1,1,15,0) "PKG",16,22,1,"PAH",1,1,16,0) "PKG",16,22,1,"PAH",1,1,17,0) ROUTINE: "PKG",16,22,1,"PAH",1,1,18,0) ======== "PKG",16,22,1,"PAH",1,1,19,0) SDES: VSE-1463 "PKG",16,22,1,"PAH",1,1,20,0) SDESBLKANDMOVE: VSE-1463 "PKG",16,22,1,"PAH",1,1,21,0) SDESJSON: VSE-1463 "PKG",16,22,1,"PAH",1,1,22,0) SDECAR: VSE-1600 "PKG",16,22,1,"PAH",1,1,23,0) SDEC797P: VSE-1464 "PKG",16,22,1,"PAH",1,1,24,0) "PKG",16,22,1,"PAH",1,1,25,0) RPC: "PKG",16,22,1,"PAH",1,1,26,0) ==== "PKG",16,22,1,"PAH",1,1,27,0) SDEC GETVVSMAKEINFO JSON: VSE-1431, VSE-1434 "PKG",16,22,1,"PAH",1,1,28,0) SDEC SEARCH VVS PROVIDERS JSON: VSE-1474, VSE-1509 "PKG",16,22,1,"PAH",1,1,29,0) SDES MAKE APPT BLOCK AND MOVE: VSE-1463 "PKG",16,22,1,"PAH",1,1,30,0) SDES SEARCH CLINIC "PKG",16,22,1,"PAH",1,1,31,0) "PKG",16,22,1,"PAH",1,1,32,0) OPTION: "PKG",16,22,1,"PAH",1,1,33,0) ======= "PKG",16,22,1,"PAH",1,1,34,0) SDECRPC: VSE-1434, VSE-1474, VSE-1509, VSE-1559 "PKG",16,22,1,"PAH",1,1,35,0) SDESRPC: VSE-1463 "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") 12 "RTN","SDEC08") 0^8^B182181620^B182201486 "RTN","SDEC08",1,0) SDEC08 ;ALB/SAT/JSM,WTC,LAB,LEG,RRM - VISTA SCHEDULING RPCS ;Jul 14, 2021@09:30 "RTN","SDEC08",2,0) ;;5.3;Scheduling;**627,651,658,665,722,740,744,694,745,756,774,781,785,790,792,796,797**;Aug 13, 1993;Build 8 "RTN","SDEC08",3,0) ;;Per VHA Directive 6402, this routine should not be modified "RTN","SDEC08",4,0) ; "RTN","SDEC08",5,0) ; Reference to ^DPT (Patient File) is supported by IA #7030 "RTN","SDEC08",6,0) Q "RTN","SDEC08",7,0) ; "RTN","SDEC08",8,0) APPDEL(SDECY,SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER,SOURCE,SDF,SDECCMT,NEWPID) ;Cancels appointment "RTN","SDEC08",9,0) ;APPDEL(SDECY,SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER,SOURCE,SDF,SDECCMT) external parameter tag is in SDEC "RTN","SDEC08",10,0) ;SDECAPTID - (required) pointer to SDEC APPOINTMENT file #409.84 "RTN","SDEC08",11,0) ;SDECTYP - (required) appointment Status valid values: "RTN","SDEC08",12,0) ; C=CANCELLED BY CLINIC "RTN","SDEC08",13,0) ; PC=CANCELLED BY PATIENT "RTN","SDEC08",14,0) ;SDECCR - (required) pointer to CANCELLATION REASON File (409.2) "RTN","SDEC08",15,0) ;SDECNOT - (optional) text representing user note "RTN","SDEC08",16,0) ;SDECDATE - (optional) Cancel Date/Time in external format; defaults to NOW "RTN","SDEC08",17,0) ;SDUSER - (optional) User that cancelled appt; defaults to current user "RTN","SDEC08",18,0) ;SOURCE - future enhancment L 1.8 SD*5.3*715 "RTN","SDEC08",19,0) ;SDF - (optional) Flag to determine whether to reopen appointment SD*5.3*745 "RTN","SDEC08",20,0) ;SDECCMT - (optional) List of cancellation comment hash tags (see #409.88) separated by ^ - 756 6/8/2020 wtc "RTN","SDEC08",21,0) ;NEWPID - (optional) Only allowed when cancelling a recall request appointment by patient "RTN","SDEC08",22,0) ;Returns error code in recordset field ERRORID "RTN","SDEC08",23,0) ; "RTN","SDEC08",24,0) N SDECNOD,SDECPATID,SDECSTART,DIK,DA,SDECID,SDECI,SDECZ,SDECERR "RTN","SDEC08",25,0) N SDECLOC,SDECLEN,SDECSCIEN,SDECSCIEN1,SDECNOEV,SDECSC1,SDRET "RTN","SDEC08",26,0) N %DT,X,Y,SDECJ ; wtc 756 6/8/2020 added SDECJ "RTN","SDEC08",27,0) I $G(NEWPID)'="" D "RTN","SDEC08",28,0) .S NEWPID=$$NETTOFM^SDECDATE(NEWPID,"N","N") "RTN","SDEC08",29,0) S SDF=$S($G(SDF)=2:2,1:1) ; lab 745 default all flags to 1 except a flag of 2. "RTN","SDEC08",30,0) S SDECNOEV=1 ;Don't execute SDEC CANCEL APPOINTMENT protocol "RTN","SDEC08",31,0) S SDECSCIEN1=0 "RTN","SDEC08",32,0) ; "RTN","SDEC08",33,0) S SDECI=0 "RTN","SDEC08",34,0) S SDECY="^TMP(""SDEC08"","_$J_",""APPDEL"")" "RTN","SDEC08",35,0) K @SDECY "RTN","SDEC08",36,0) S @SDECY@(SDECI)="T00020ERRORID"_$C(30) "RTN","SDEC08",37,0) S SDECI=SDECI+1 "RTN","SDEC08",38,0) ;validate SDEC APPOINTMENT pointer (required) "RTN","SDEC08",39,0) I '$D(^SDEC(409.84,+$G(SDECAPTID),0)) D ADERR(SDECI,.SDECY,"SDEC08: Invalid Appointment ID",+$G(SDECAPTID),0) Q ;BI/SD*5.3*740 added ADERR "RTN","SDEC08",40,0) ;validate appointment status type (required) "RTN","SDEC08",41,0) S SDECTYP=$G(SDECTYP) "RTN","SDEC08",42,0) S SDECTYP=$S(SDECTYP="C":"C",SDECTYP="CANCELLED BY CLINIC":"C",SDECTYP="PC":"PC",SDECTYP="CANCELLED BY PATIENT":"PC",1:"") "RTN","SDEC08",43,0) I SDECTYP="" D ADERR(SDECI,.SDECY,"SDEC08: Invalid status type",+$G(SDECAPTID),0) Q ;BI/SD*5.3*740 added ADERR "RTN","SDEC08",44,0) ;validate CANCELLATION REASON pointer (optional) "RTN","SDEC08",45,0) S SDECCR=$G(SDECCR) "RTN","SDEC08",46,0) I SDECCR'="" I '$D(^SD(409.2,+SDECCR,0)) S SDECCR=$O(^SD(409.2,"B","SDECCR",0)) "RTN","SDEC08",47,0) ;validate SDECNOT "RTN","SDEC08",48,0) S SDECNOT=$TR($G(SDECNOT),"^"," ") ;alb/sat 658 - strip out ^ "RTN","SDEC08",49,0) ; "RTN","SDEC08",50,0) ; Add cancellation comment HASHTAGs from #409.88 to beginning of user note. - 756 wtc 6/8/2020 "RTN","SDEC08",51,0) ; "RTN","SDEC08",52,0) I $G(SDECCMT)'="" F SDECJ=$L(SDECCMT,U):-1:1 S SDECNOT=$P(SDECCMT,U,SDECJ)_"_"_SDECNOT ; Add hashtags in reverse order of receipt so national appear first. wtc 8/19/2020 "RTN","SDEC08",53,0) I $E(SDECNOT,$L(SDECNOT))="_" S SDECNOT=$E(SDECNOT,1,$L(SDECNOT)-1) ; Strip off trailing "_". Happens if not extra note text. "RTN","SDEC08",54,0) ; "RTN","SDEC08",55,0) ;validate cancel date/time "RTN","SDEC08",56,0) S SDECDATE=$G(SDECDATE) "RTN","SDEC08",57,0) ; "RTN","SDEC08",58,0) ; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18 "RTN","SDEC08",59,0) ; "RTN","SDEC08",60,0) ;I SDECDATE'="" S %DT="T" S X=SDECDATE D ^%DT S SDECDATE=Y I Y=-1 S SDECDATE="" "RTN","SDEC08",61,0) I SDECDATE'="" S SDECDATE=$$NETTOFM^SDECDATE(SDECDATE,"Y","N") I SDECDATE=-1 S SDECDATE="" ; wtc 6/18/18 "RTN","SDEC08",62,0) I $G(SDECDATE)="" S SDECDATE=$$NOW^XLFDT "RTN","SDEC08",63,0) ;validate user "RTN","SDEC08",64,0) S SDUSER=$G(SDUSER) "RTN","SDEC08",65,0) I SDUSER'="" I '$D(^VA(200,+SDUSER,0)) S SDUSER="" "RTN","SDEC08",66,0) I SDUSER="" S SDUSER=DUZ "RTN","SDEC08",67,0) ;Delete APPOINTMENT entries "RTN","SDEC08",68,0) S SDECNOD=^SDEC(409.84,SDECAPTID,0) "RTN","SDEC08",69,0) S SDECPATID=$P(SDECNOD,U,5) "RTN","SDEC08",70,0) S SDECSTART=$P(SDECNOD,U) "RTN","SDEC08",71,0) ; "RTN","SDEC08",72,0) ;Lock SDEC node "RTN","SDEC08",73,0) ;changed SDECPATID to SDECAPTID to get APPOINTMENT ID instead of PATIENT ID ; pwc *745 7/16/2020 "RTN","SDEC08",74,0) L +^SDEC(409.84,SDECAPTID):5 I '$T D ADERR(SDECI+1,.SDECY,"Another user is working with this patient's record. Please try again later",+SDECAPTID,0) Q ;BI/SD *5.3*740 "RTN","SDEC08",75,0) ;cancel check-in if walk-in "RTN","SDEC08",76,0) I $P(SDECNOD,U,13)="y" D "RTN","SDEC08",77,0) .S SDRET="" "RTN","SDEC08",78,0) .D CHECKIN^SDEC25(.SDRET,SDECAPTID,"@") "RTN","SDEC08",79,0) ;cancel SDEC APPOINTMENT record "RTN","SDEC08",80,0) D SDECCAN(SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER,SDF,$G(NEWPID)) ;*745 "RTN","SDEC08",81,0) ; "RTN","SDEC08",82,0) S SDECSC1=$P(SDECNOD,U,7) ;RESOURCEID "RTN","SDEC08",83,0) I SDECSC1]"",$D(^SDEC(409.831,SDECSC1,0)) D I +$G(SDECZ) S SDECERR=+SDECZ D ADERR(SDECI,.SDECY,$P(SDECZ,U,2),+SDECAPTID,1) Q ;BI/SD*5.3*740 added ADERR ;changed SDECPATID to SDECAPTID - pwc *745 "RTN","SDEC08",84,0) . S SDECNOD=^SDEC(409.831,SDECSC1,0) "RTN","SDEC08",85,0) . S SDECLOC=$P(SDECNOD,U,4) ;HOSPITAL LOCATION "RTN","SDEC08",86,0) . Q:'+SDECLOC "RTN","SDEC08",87,0) . S SDECSCIEN=$$SCIEN^SDECU2(SDECPATID,SDECLOC,SDECSTART) I SDECSCIEN="" D I 'SDECZ Q ;Q:SDECZ "RTN","SDEC08",88,0) .. S SDECERR="SDEC08: Unable to find associated appointment for this patient. " "RTN","SDEC08",89,0) .. S SDECZ=1 I '$D(^SDEC(409.831,SDECSC1,20)) S SDECZ=0 Q "RTN","SDEC08",90,0) .. N SDEC1 S SDEC1=0 "RTN","SDEC08",91,0) .. F S SDEC1=$O(^SDEC(409.831,SDECSC1,20,SDEC1)) Q:'+SDEC1 Q:SDECZ=0 D "RTN","SDEC08",92,0) ... Q:'$D(^SDEC(409.831,SDECSC1,20,SDEC1,0)) "RTN","SDEC08",93,0) ... S SDECLOC=$P(^SDEC(409.831,SDECSC1,20,SDEC1,0),U) "RTN","SDEC08",94,0) ... S SDECSCIEN=$$SCIEN^SDECU2(SDECPATID,SDECLOC,SDECSTART) I +SDECSCIEN S SDECZ=0 Q "RTN","SDEC08",95,0) . S SDECERR="SDEC08: CANCEL^SDEC08 Returned " "RTN","SDEC08",96,0) . I SDECLOC']"" S SDECZ="0^Unable to find associated appointment for this patient." Q "RTN","SDEC08",97,0) . I '$D(^SC(SDECLOC,0)) S SDECZ="0^Unable to find associated appointment for this patient." Q "RTN","SDEC08",98,0) . S SDECNOD=$G(^SC(SDECLOC,"S",SDECSTART,1,+SDECSCIEN,0)) "RTN","SDEC08",99,0) . I SDECNOD="" S SDECZ="0^Unable to find associated appointment for this patient." Q "RTN","SDEC08",100,0) . S SDECLEN=$P(SDECNOD,U,2) "RTN","SDEC08",101,0) . D APCAN^SDEC08A(.SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECAPTID,SDECLEN) "RTN","SDEC08",102,0) . Q:+$G(SDECZ) "RTN","SDEC08",103,0) . D AVUPDT^SDEC08A(SDECLOC,SDECSTART,SDECLEN) ;moved to SDEC08A routine is too big *745 "RTN","SDEC08",104,0) . D AR433D^SDECAR2(SDECAPTID) "RTN","SDEC08",105,0) L -^SDEC(409.84,SDECAPTID) ;changed SDECPATID to SDECAPTID ; pwc *745 "RTN","SDEC08",106,0) S SDECI=SDECI+1 "RTN","SDEC08",107,0) S @SDECY@(SDECI)=""_$C(30) "RTN","SDEC08",108,0) S SDECI=SDECI+1 "RTN","SDEC08",109,0) S @SDECY@(SDECI)=$C(31) "RTN","SDEC08",110,0) Q "RTN","SDEC08",111,0) ; "RTN","SDEC08",112,0) ADERR(SDECI,SDECY,SDECERR,SDECAPTID,LOCK) ;Error processing BI/SD*5.3*740 ;changed SDECPATID to SDECAPTID ; pwc *745 "RTN","SDEC08",113,0) S SDECI=SDECI+1 "RTN","SDEC08",114,0) S SDECERR=$TR(SDECERR,"^","~") "RTN","SDEC08",115,0) S @SDECY@(SDECI)=SDECERR_$C(30) "RTN","SDEC08",116,0) S SDECI=SDECI+1 "RTN","SDEC08",117,0) S @SDECY@(SDECI)=$C(31) "RTN","SDEC08",118,0) I LOCK=1 L -^SDEC(409.84,SDECAPTID) ; changed SDECPATID to SDECAPTID ; pwc *745 "RTN","SDEC08",119,0) Q "RTN","SDEC08",120,0) ; "RTN","SDEC08",121,0) SDECCAN(SDECAPTID,SDECTYP,SDECCR,SDECNOT,SDECDATE,SDUSER,SDF,NEWPID) ;cancel SDEC APPOINTMENT entry "RTN","SDEC08",122,0) ;SDECAPTID - (required) pointer to SDEC APPOINTMENT file "RTN","SDEC08",123,0) ;SDECTYP - (required) appointment Status valid values: "RTN","SDEC08",124,0) ; C=CANCELLED BY CLINIC "RTN","SDEC08",125,0) ; PC=CANCELLED BY PATIENT "RTN","SDEC08",126,0) ;SDECCR - (required) pointer to CANCELLATION REASON File (409.2) "RTN","SDEC08",127,0) ;SDECNOT - (optional) text representing user note "RTN","SDEC08",128,0) ;SDECDATE - (optional) Cancel Date/Time in fm format; defaults to NOW) ; "RTN","SDEC08",129,0) ;SDF - (optional) flags ;*745 expanded flag explanation "RTN","SDEC08",130,0) ; "1" or null - update consult only. (assumption called from a GUI) "RTN","SDEC08",131,0) ; "01" (two digit) -do not reopen appt (called from cancel in SDAM) "RTN","SDEC08",132,0) ; "2" - close appt request disp code REMOVED/EXTERNAL APP "RTN","SDEC08",133,0) ;NEWPID - (optional) Only allowed when cancelling a recall request appointment by patient "RTN","SDEC08",134,0) ; "RTN","SDEC08",135,0) ;Cancel SDEC APPOINTMENT entry "RTN","SDEC08",136,0) N DFN,PROVIEN,Y "RTN","SDEC08",137,0) N SAVESTRT,SDAPTYP,SDCL,SDI,SDIEN,SDECIENS,SDECFDA,SDECMSG,SDECWP,SDRES,SDT ;alb/sat 651 add SAVESTRT and SDRES "RTN","SDEC08",138,0) N DFN40985,IEN40986 ;**792 "RTN","SDEC08",139,0) S SDF=$G(SDF,0) "RTN","SDEC08",140,0) S NEWPID=$G(NEWPID) "RTN","SDEC08",141,0) S DFN=$$GET1^DIQ(409.84,SDECAPTID_",",.05,"I") ;alb/sat 658;781 lab added, "I" "RTN","SDEC08",142,0) S SDT=$$GET1^DIQ(409.84,SDECAPTID_",",.01,"I") "RTN","SDEC08",143,0) S SAVESTRT=$$GET1^DIQ(409.84,SDECAPTID_",",.01) ;alb/sat 651 "RTN","SDEC08",144,0) S SDRES=$$GET1^DIQ(409.84,SDECAPTID_",",.07,"I") ;alb/sat 651 "RTN","SDEC08",145,0) S SDECIENS=SDECAPTID_"," "RTN","SDEC08",146,0) S SDECFDA(409.84,SDECIENS,.12)=$S($G(SDECDATE)'="":SDECDATE,1:$$NOW^XLFDT) "RTN","SDEC08",147,0) S SDECFDA(409.84,SDECIENS,.121)=$S($G(SDUSER)'="":SDUSER,1:DUZ) "RTN","SDEC08",148,0) S:$G(SDECCR)'="" SDECFDA(409.84,SDECIENS,.122)=SDECCR "RTN","SDEC08",149,0) S SDECFDA(409.84,SDECIENS,.17)=SDECTYP "RTN","SDEC08",150,0) S SDECFDA(409.84,SDECIENS,2)="@" ;patch SD*5.3*796, delete VVS appointment ID if appoinment is cancelled "RTN","SDEC08",151,0) K SDECMSG "RTN","SDEC08",152,0) D FILE^DIE("","SDECFDA","SDECMSG") "RTN","SDEC08",153,0) S SDAPTYP=$$GET1^DIQ(409.84,SDECAPTID_",",.22,"I") "RTN","SDEC08",154,0) ;alb/sat 658 modification begin "RTN","SDEC08",155,0) S SDECNOT=$G(SDECNOT) ;,SDECNOT=$E(SDECNOT,1,160) - removed 160 character restriction so entire note is stored in #409.84 - wtc 756 "RTN","SDEC08",156,0) I $L(SDECNOT)>2,'$E(SDF,2) K SDECFDA "RTN","SDEC08",157,0) S SDECFDA(2.98,SDT_","_DFN_",",17)=$E(SDECNOT,1,160) D UPDATE^DIE("","SDECFDA") ; restrict note in #2 to 160 characters - wtc 756 "RTN","SDEC08",158,0) ;alb/sat 658 modification end "RTN","SDEC08",159,0) I $P(SDAPTYP,";",2)="GMR(123,",$E(SDF,1),(SDF'=2) D "RTN","SDEC08",160,0) .S SDCL=$$SDCL^SDECUTL(SDECAPTID) "RTN","SDEC08",161,0) .S PROVIEN=$$GET1^DIQ(44,SDCL_",",16,"I") "RTN","SDEC08",162,0) .D REQSET^SDEC07A($P(SDAPTYP,";",1),PROVIEN,"",2,SDECTYP,SDECNOT,SAVESTRT,SDRES) ;651 added SAVESTRT "RTN","SDEC08",163,0) .Q "RTN","SDEC08",164,0) I $P(SDAPTYP,";",2)="SDEC(409.85," D ;update APPT "RTN","SDEC08",165,0) .K SDECFDA,SDECMSG,SDECWP "RTN","SDEC08",166,0) .D:'$E(SDF,2) AROPEN^SDECAR("",SDECAPTID) ;658 don't reopen if called from SDEC^SDCNP0 "RTN","SDEC08",167,0) .S SDIEN=$P(SDAPTYP,";",1) "RTN","SDEC08",168,0) .S SDECFDA(409.85,SDIEN_",",13)="@" "RTN","SDEC08",169,0) .S SDECFDA(409.85,SDIEN_",",13.1)="@" "RTN","SDEC08",170,0) .S SDECFDA(409.85,SDIEN_",",13.2)="@" "RTN","SDEC08",171,0) .S SDECFDA(409.85,SDIEN_",",13.3)="@" "RTN","SDEC08",172,0) .S SDECFDA(409.85,SDIEN_",",13.4)="@" "RTN","SDEC08",173,0) .S SDECFDA(409.85,SDIEN_",",13.5)="@" "RTN","SDEC08",174,0) .S SDECFDA(409.85,SDIEN_",",13.6)="@" "RTN","SDEC08",175,0) .S SDECFDA(409.85,SDIEN_",",13.7)="@" "RTN","SDEC08",176,0) .S SDECFDA(409.85,SDIEN_",",13.8)="@" "RTN","SDEC08",177,0) .D UPDATE^DIE("","SDECFDA") "RTN","SDEC08",178,0) .I SDF=2 NEW INP S INP(1)=SDIEN S INP(2)="REMOVED/EXTERNAL APP" S INP(3)=SDUSER S INP(4)=DT D ARCLOSE^SDECAR("",.INP) ;*745 "RTN","SDEC08",179,0) ; "RTN","SDEC08",180,0) ; VSE-863; 6/6/2021 ; create new "APPT" Request if A "RECALL" Appt is Cancelled "RTN","SDEC08",181,0) I $P(SDAPTYP,";",2)="SD(403.5," D RECREQ^SDECRECREQ(.SDECY,SDECAPTID,SDAPTYP,$G(NEWPID)) "RTN","SDEC08",182,0) Q "RTN","SDEC08",183,0) ; "RTN","SDEC08",184,0) CANEVT(SDECPAT,SDECSTART,SDECSC) ;EP Called by SDEC CANCEL APPOINTMENT "RTN","SDEC08",185,0) ;when Appt cancelled via PIMS interface. "RTN","SDEC08",186,0) ;Propagates canceL to SDECAPPT & raises refresh event to running GUI clients "RTN","SDEC08",187,0) N SDECFOUND,SDECRES "RTN","SDEC08",188,0) Q:+$G(SDECNOEV) "RTN","SDEC08",189,0) Q:'+$G(SDECSC) "RTN","SDEC08",190,0) S SDECFOUND=0 "RTN","SDEC08",191,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",192,0) I SDECFOUND D CANEVT3(SDECRES) Q "RTN","SDEC08",193,0) Q "RTN","SDEC08",194,0) ; "RTN","SDEC08",195,0) CANEVT1(SDECRES,SDECSTART,SDECPAT) ; "RTN","SDEC08",196,0) ;Get Appt ID in SDECAPT "RTN","SDEC08",197,0) ;If found, call SDECCAN(SDECAPPT) and return 1 "RTN","SDEC08",198,0) ;else return 0 "RTN","SDEC08",199,0) N SDECFOUND,SDECAPPT "RTN","SDEC08",200,0) S SDECFOUND=0 "RTN","SDEC08",201,0) Q:'+SDECRES SDECFOUND "RTN","SDEC08",202,0) Q:'$D(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART)) SDECFOUND "RTN","SDEC08",203,0) S SDECAPPT=0 F S SDECAPPT=$O(^SDEC(409.84,"ARSRC",SDECRES,SDECSTART,SDECAPPT)) Q:'+SDECAPPT D Q:SDECFOUND "RTN","SDEC08",204,0) . S SDECNOD=$G(^SDEC(409.84,SDECAPPT,0)) Q:SDECNOD="" "RTN","SDEC08",205,0) . I $P(SDECNOD,U,5)=SDECPAT,$P(SDECNOD,U,12)="" S SDECFOUND=1 Q "RTN","SDEC08",206,0) I SDECFOUND,+$G(SDECAPPT) D SDECCAN(SDECAPPT,,,,,,1) "RTN","SDEC08",207,0) Q SDECFOUND "RTN","SDEC08",208,0) ; "RTN","SDEC08",209,0) CANEVT3(SDECRES) ; "RTN","SDEC08",210,0) ;Call RaiseEvent to notify GUI clients "RTN","SDEC08",211,0) Q "RTN","SDEC08",212,0) N SDECRESN "RTN","SDEC08",213,0) S SDECRESN=$G(^SDEC(409.831,SDECRES,0)) "RTN","SDEC08",214,0) Q:SDECRESN="" "RTN","SDEC08",215,0) S SDECRESN=$P(SDECRESN,"^") "RTN","SDEC08",216,0) Q "RTN","SDEC08",217,0) ; "RTN","SDEC08",218,0) CANCEL(BSDR) ;EP; called to cancel appt "RTN","SDEC08",219,0) ; Make call using: S ERR=$$CANCEL^SDEC08(.ARRAY) "RTN","SDEC08",220,0) ; "RTN","SDEC08",221,0) ; Input Array - "RTN","SDEC08",222,0) ; BSDR("PAT") = ien of patient file 2 "RTN","SDEC08",223,0) ; BSDR("CLN") = ien of clinic file 44 "RTN","SDEC08",224,0) ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled "RTN","SDEC08",225,0) ; BSDR("ADT") = appointment date and time "RTN","SDEC08",226,0) ; BSDR("CDT") = cancel date and time "RTN","SDEC08",227,0) ; BSDR("USR") = user who canceled appt "RTN","SDEC08",228,0) ; BSDR("CR") = cancel reason - pointer to file 409.2 "RTN","SDEC08",229,0) ; BSDR("NOT") = cancel remarks - optional notes to 160 characters "RTN","SDEC08",230,0) ; "RTN","SDEC08",231,0) ;Output: error status and message "RTN","SDEC08",232,0) ; = 0 or null: everything okay "RTN","SDEC08",233,0) ; = 1^message: error and reason "RTN","SDEC08",234,0) ; "RTN","SDEC08",235,0) I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) "RTN","SDEC08",236,0) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) "RTN","SDEC08",237,0) I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP")) "RTN","SDEC08",238,0) I $G(BSDR("ADT"))'?7N1"."1N.N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) ;PWC allow any time combination of numbers #694 "RTN","SDEC08",239,0) I $G(BSDR("CDT"))'?7N1"."1N.N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) ;PWC allow any time combination of numbers #694 "RTN","SDEC08",240,0) I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR")) "RTN","SDEC08",241,0) I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR")) "RTN","SDEC08",242,0) ; "RTN","SDEC08",243,0) NEW IEN,DIE,DA,DR,SDMODE,HLAPTIEN ;*zeb+1 722 2/21/19 save IEN for canceling appt "RTN","SDEC08",244,0) S IEN=$$SCIEN^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")),HLAPTIEN=IEN "RTN","SDEC08",245,0) I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") "RTN","SDEC08",246,0) ; "RTN","SDEC08",247,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",248,0) ; "RTN","SDEC08",249,0) ; remember before status "RTN","SDEC08",250,0) NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL "RTN","SDEC08",251,0) S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN "RTN","SDEC08",252,0) S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL "RTN","SDEC08",253,0) D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL) "RTN","SDEC08",254,0) ; "RTN","SDEC08",255,0) ; get user who made appt and date appt made from ^SC "RTN","SDEC08",256,0) ; because data in ^SC will be deleted "RTN","SDEC08",257,0) NEW USER,DATE "RTN","SDEC08",258,0) S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6) "RTN","SDEC08",259,0) S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7) "RTN","SDEC08",260,0) ; "RTN","SDEC08",261,0) ; update file 2 info "RTN","SDEC08",262,0) NEW DIE,DA,DR "RTN","SDEC08",263,0) N SDFDA,SDIEN,SDMSG "RTN","SDEC08",264,0) S SDFDA="SDFDA(2.98,SDT_"",""_DFN_"","")" "RTN","SDEC08",265,0) S @SDFDA@(3)=BSDR("TYP") "RTN","SDEC08",266,0) S @SDFDA@(14)=BSDR("USR") "RTN","SDEC08",267,0) S @SDFDA@(15)=BSDR("CDT") "RTN","SDEC08",268,0) S:+$G(BSDR("CR")) @SDFDA@(16)=BSDR("CR") "RTN","SDEC08",269,0) S:$G(BSDR("NOT"))]"" @SDFDA@(17)=$E(BSDR("NOT"),1,160) "RTN","SDEC08",270,0) S @SDFDA@(19)=USER "RTN","SDEC08",271,0) S @SDFDA@(20)=DATE "RTN","SDEC08",272,0) D UPDATE^DIE("","SDFDA") ; ICR #7030 wtc 756 6/15/2020 "RTN","SDEC08",273,0) N SDPCE "RTN","SDEC08",274,0) S SDPCE=$P($G(^DPT(DFN,"S",SDT,0)),U,20) ; ICR #7030 wtc 756 6/15/2020 "RTN","SDEC08",275,0) D:+SDPCE EN^SDCODEL(SDPCE,2,"","CANCEL") ;remove OUTPATIENT ENCOUNTER link ;*zeb 10/25/18 722 pass in correct SDMODE and delete source "RTN","SDEC08",276,0) S $P(^SC(BSDR("CLN"),"S",BSDR("ADT"),1,HLAPTIEN,0),"^",9)="C" "RTN","SDEC08",277,0) ; call event driver "RTN","SDEC08",278,0) S SDATA=SDDA_U_DFN_U_SDT_U_SDCL "RTN","SDEC08",279,0) D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL) ;*zeb 10/25/18 722 uncomment to re-enable event driver "RTN","SDEC08",280,0) Q 0 "RTN","SDEC08",281,0) ; "RTN","SDEC08",282,0) UNDOCANA(SDECY,SDECAPTID) ;Undo Cancel Appointment "RTN","SDEC08",283,0) ;UNDOCANA(SDECY,SDECAPTID) external parameter tag in SDEC "RTN","SDEC08",284,0) ;called by SDEC UNCANCEL APPT "RTN","SDEC08",285,0) ; SDECAPTID = ien of appointment in SDEC APPOINTMENT (^SDECAPPT) file 409.84 "RTN","SDEC08",286,0) N SDECDAM,SDECDEC,SDECI,SDECNOD,SDECPATID,SDECSTART,SDECNOTE,SDECWKIN "RTN","SDEC08",287,0) S SDECNOEV=1 ;Don't execute SDEC CANCEL APPOINTMENT protocol ;is this used? "RTN","SDEC08",288,0) ; "RTN","SDEC08",289,0) S SDECI=0 "RTN","SDEC08",290,0) K ^TMP("SDEC",$J) "RTN","SDEC08",291,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDEC08",292,0) S ^TMP("SDEC",$J,SDECI)="T00020ERRORID"_$C(30) "RTN","SDEC08",293,0) I '+SDECAPTID D ERR(SDECI+1,"Invalid Appointment ID.",+$G(SDECAPTID),0) Q ;BI/SD*5.3*740 "RTN","SDEC08",294,0) I '$D(^SDEC(409.84,SDECAPTID,0)) D ERR(SDECI+1,"Invalid Appointment ID",+SDECAPTID,0) Q ;BI/SD*5.3*740 "RTN","SDEC08",295,0) ;Make sure appointment is cancelled "RTN","SDEC08",296,0) I $$GET1^DIQ(409.84,SDECAPTID_",",.12)="" D ERR(SDECI+1,"Appointment is not Cancelled.",+SDECAPTID,0) Q ;BI/SD*5.3*740 "RTN","SDEC08",297,0) S SDECNOD=^SDEC(409.84,SDECAPTID,0) "RTN","SDEC08",298,0) ;appts cancelled by patient cannot be un-cancelled. /* removed 9/17/2010 */ "RTN","SDEC08",299,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",300,0) ;get appointment data "RTN","SDEC08",301,0) S SDECNOD=^SDEC(409.84,SDECAPTID,0) "RTN","SDEC08",302,0) S SDECDAM=$P(SDECNOD,U,9) ;date appt made "RTN","SDEC08",303,0) S SDECDEC=$P(SDECNOD,U,8) ;data entry clerk "RTN","SDEC08",304,0) S SDECLEN=$P(SDECNOD,U,18) ;length of appt in minutes "RTN","SDEC08",305,0) ; "RTN","SDEC08",306,0) ; Get entire note from Appointment file. 756 wtc 1/25/2019 "RTN","SDEC08",307,0) ; "RTN","SDEC08",308,0) ;S SDECNOTE=$G(^SDEC(409.84,SDECAPTID,1,1,0)) ;note from SDEC APPOINTMENT "RTN","SDEC08",309,0) S SDECNOTE="" N I F I=1:1 Q:'$D(^SDEC(409.84,SDECAPTID,1,I,0)) S SDECNOTE=SDECNOTE_^(0)_$C(13) ; "RTN","SDEC08",310,0) ; "RTN","SDEC08",311,0) S SDECPATID=$P(SDECNOD,U,5) ;pointer to VA PATIENT file 2 "RTN","SDEC08",312,0) S SDECSC1=$P($G(SDECNOD),U,7) ;resource "RTN","SDEC08",313,0) S SDECSTART=$P(SDECNOD,U) ;appt start time "RTN","SDEC08",314,0) S SDECWKIN=$P($G(SDECNOD),U,13) ;walk-in "RTN","SDEC08",315,0) ;lock SDEC node "RTN","SDEC08",316,0) ; changed line below to use SDECAPTID instead of SDECPATID ; pwc *745 7/16/2020 "RTN","SDEC08",317,0) L +^SDEC(409.84,SDECAPTID):5 I '$T D ERR(SDECI+1,"Another user is working with this patient's record. Please try again later",+SDECAPTID,0) Q ;BI/SD*5.3*740 "RTN","SDEC08",318,0) ;un-cancel SDEC APPOINTMENT "RTN","SDEC08",319,0) D SDECUCAN^SDEC08A(SDECAPTID) ;moved to ^SDEC08A because of XINDEX size *756 PWC "RTN","SDEC08",320,0) I SDECSC1]"",$D(^SDEC(409.831,SDECSC1,0)) D I +$G(SDECZ) S SDECERR=SDECERR_$P(SDECZ,U,2) D ERR(SDECI,SDECERR,+SDECAPTID,1) Q ;BI/SD*5.3*740 ;changed SDECPATID to SDECAPTID - pwc *745 "RTN","SDEC08",321,0) . S SDECLOC="" "RTN","SDEC08",322,0) . S SDECNOD=^SDEC(409.831,SDECSC1,0) "RTN","SDEC08",323,0) . S SDECLOC=$P(SDECNOD,U,4) ;HOSPITAL LOCATION ;support for single HOSPITAL LOCATION in SDEC RESOURCE "RTN","SDEC08",324,0) . I SDECLOC="" S SDECLOC=$$SDCL^SDECUTL(SDECAPTID) ;HOSPITAL LOCATION "RTN","SDEC08",325,0) . Q:'+SDECLOC "RTN","SDEC08",326,0) . ;un-cancel patient appointment and re-instate clinic appointment "RTN","SDEC08",327,0) . S SDECZ="" "RTN","SDEC08",328,0) . D APUCAN^SDEC08A(.SDECZ,SDECLOC,SDECPATID,SDECSTART,SDECDAM,SDECDEC,SDECLEN,SDECNOTE,SDECSC1,SDECWKIN) ;moved to ^SDEC08A because of XINDEX size *756 PWC "RTN","SDEC08",329,0) L -^SDEC(409.84,SDECAPTID) ;changed SDECPATID to SDECAPTID - pwc *745 "RTN","SDEC08",330,0) S SDECI=SDECI+1 "RTN","SDEC08",331,0) S ^TMP("SDEC",$J,SDECI)=""_$C(30) "RTN","SDEC08",332,0) S SDECI=SDECI+1 "RTN","SDEC08",333,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC08",334,0) Q "RTN","SDEC08",335,0) ; "RTN","SDEC08",336,0) ERR(SDECI,SDECERR,SDECAPTID,LOCK) ;Error processing BI/SD*5.3*740 added two parameters ;changed SDECPATID to SDECAPTID - pwc *745 "RTN","SDEC08",337,0) S SDECI=SDECI+1 "RTN","SDEC08",338,0) S SDECERR=$TR(SDECERR,"^","~") "RTN","SDEC08",339,0) S ^TMP("SDEC",$J,SDECI)=SDECERR_$C(30) "RTN","SDEC08",340,0) S SDECI=SDECI+1 "RTN","SDEC08",341,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC08",342,0) I $G(LOCK)=1 L -^SDEC(409.84,SDECAPTID) ;BI/SD*5.3*740 ;changed SDECPATID to SDECAPTID - pwc *745 "RTN","SDEC08",343,0) Q "RTN","SDEC08",344,0) ; "RTN","SDEC08",345,0) ETRAP ;EP Error trap entry "RTN","SDEC08",346,0) D ^%ZTER "RTN","SDEC08",347,0) I '$D(SDECI) N SDECI S SDECI=999999 "RTN","SDEC08",348,0) S SDECI=SDECI+1 "RTN","SDEC08",349,0) D ERR(SDECI,"SDEC08 Error") "RTN","SDEC08",350,0) Q "RTN","SDEC1") 0^5^B12073914^B9928206 "RTN","SDEC1",1,0) SDEC1 ;ALB/LAB/ANU/MGD - VISTA SCHEDULING RPCS ;Apr 28, 2021@15:53:20 "RTN","SDEC1",2,0) ;;5.3;Scheduling;**774,781,784,785,797**;Aug 13, 1993;Build 8 "RTN","SDEC1",3,0) ;;Per VHA Directive 6402, this routine should not be modified "RTN","SDEC1",4,0) ; "RTN","SDEC1",5,0) ARGETIEN(RET,IEN) ;RPC: SDEC GET PAT APPT REQ BY IEN "RTN","SDEC1",6,0) D ARGETIEN^SDECAR4(.RET,IEN) Q "RTN","SDEC1",7,0) ARGETPAT(RET,DFN) ;RPC: SDEC PATIENT APPT REQ GET "RTN","SDEC1",8,0) D ARGETPAT^SDECAR4(.RET,DFN) Q "RTN","SDEC1",9,0) ARGETPATJSON(RET,DFN) ;RPC: SDEC APPT REQ GET PATIENT JSON "RTN","SDEC1",10,0) D ARGETPATJSON^SDECAR4(.RET,DFN) Q "RTN","SDEC1",11,0) CONSLIST(SDECY,DFN) ;EP SDEC GET PATIENT CONSULTS "RTN","SDEC1",12,0) D CONSLIST^SDEC51B(.SDECY,DFN) Q ;Return a list of ACTIVE or PENDING CONSULTS for patient "RTN","SDEC1",13,0) CONSULT1(SDECY,IEN) ; This RPC returns the patient Consult associated with a given IEN - SDEC GET PAT CONSULT BY IEN "RTN","SDEC1",14,0) D CONSULT1^SDEC51B(.SDECY,IEN) Q "RTN","SDEC1",15,0) CLGRPLK(SDECY,SRCHAR) ;EP SDEC CLINIC GROUP LOOKUP "RTN","SDEC1",16,0) D CLGRPLK^SDEC63(.SDECY,SRCHAR) Q "RTN","SDEC1",17,0) DISMULT(RTT,CIEN) ; RPC: SDEC CONTACT MULTI-DISPLAY "RTN","SDEC1",18,0) D DISMULT^SDECCON(.RTT,CIEN) Q "RTN","SDEC1",19,0) DELETEVVSID(RETURN,DFN,RESOURCE,APPTDATETIME) ;This RPC deletes Video Visit ID from SDEC APPOINTMENT(#409.84) file "RTN","SDEC1",20,0) D DELETEVVSID^SDECVVS(.RETURN,DFN,RESOURCE,APPTDATETIME) Q "RTN","SDEC1",21,0) DISPLAY(RTU,DFN,CLN,PDT,REQT,SER) ; RPC: SDEC CONTACT DISPLAY "RTN","SDEC1",22,0) D DISPLAY^SDECCON(.RTU,DFN,CLN,PDT,REQT,SER) Q "RTN","SDEC1",23,0) DISPLAY1(RTU,REQT,RIEN) ; RPC: SDEC CONTACT DISPLAY SINGLE "RTN","SDEC1",24,0) D DISPLAY1^SDECCON(.RTU,REQT,RIEN) Q ; RPC: SDEC CONTACT DISPLAY SINGLE "RTN","SDEC1",25,0) GETPATDEMOG(SDECY,SDECP,SDECC,LASTSUB) ;EP Patient Lookup "LITE"; VSE-664 "RTN","SDEC1",26,0) D GETPATDEMOG^SDEC28L(.SDECY,$G(SDECP),$G(SDECC),$G(LASTSUB)) Q "RTN","SDEC1",27,0) GETPATIENTICN(RETURN,PATIENTIEN) ;GET PATIENT ICN FROM PATIENT IEN (DFN) "RTN","SDEC1",28,0) D GETPATIENTICN^SDECVVS(.RETURN,PATIENTIEN) Q "RTN","SDEC1",29,0) GETSTC(RET,CLIEN) ; RPC: SDEC CONTACT STOP CODE "RTN","SDEC1",30,0) D GETSTC^SDECCON(.RET,CLIEN) Q "RTN","SDEC1",31,0) GETSPACEBARPRO(VVSPRORETURN) ;SPACEBAR RETURN LAST PROVIDER "RTN","SDEC1",32,0) D GETSPACEBARPRO^SDECVVS(.VVSPRORETURN) Q "RTN","SDEC1",33,0) GETVVSMAKEINFO(VVSMAKEINFO,PATIENTIEN,CLINICIEN) ;GET INFO TO MAKE A VIDEO VISIT WEB SERVICE (VVS) CALL "RTN","SDEC1",34,0) D GETVVSMAKEINFO^SDECVVS(.VVSMAKEINFO,PATIENTIEN,CLINICIEN) Q "RTN","SDEC1",35,0) GETWLIEN(RET,APPTIEN) ; "RTN","SDEC1",36,0) D GETWLIEN^SDEC63(.RET,APPTIEN) Q "RTN","SDEC1",37,0) GETVVSID(RETURN,DFN,RESOURCE,APPTDATETIME) ;This RPC returns the Video Visit Service (VVS) ID. "RTN","SDEC1",38,0) D GETVVSID^SDECVVS(.RETURN,DFN,RESOURCE,APPTDATETIME) Q "RTN","SDEC1",39,0) JSONCONSLIST(SDEC,DFN) ;EP RPC: SDEC GET PATIENT CONSULTS JSON "RTN","SDEC1",40,0) D JSONCONSLIST^SDECCONSJSON(.SDEC,DFN) Q "RTN","SDEC1",41,0) JSONCONSLIST1(SDEC,IEN) ;EP RPC: SDEC GET PATIENT CONSULT JSON "RTN","SDEC1",42,0) D JSONCONSLIST1^SDECCONSJSON(.SDEC,IEN) Q "RTN","SDEC1",43,0) NEW(RET,DFN,CLI,DTP,REQT,SRV,DTCON,CONT,COM,DTENT,RIEN) ; RPC: SDEC CONTACT NEW "RTN","SDEC1",44,0) D NEW^SDECCON(.RET,DFN,CLI,DTP,REQT,SRV,DTCON,CONT,COM,DTENT,RIEN) Q "RTN","SDEC1",45,0) RECGET(SDECY,DFN) ;This RPC returns all open recall requests associated with a patient in a delimited string "RTN","SDEC1",46,0) D RECGET^SDEC52C(.SDECY,DFN) Q "RTN","SDEC1",47,0) RECGETJSON(SDECY,DFN) ; This RPC returns all open recall requests associated with a patient in JSON format "RTN","SDEC1",48,0) D RECGETJSON^SDEC52CJSON(.SDECY,DFN) Q "RTN","SDEC1",49,0) RECGETONE(SDECY,IEN) ; This RPC returns the open recall associated with a given IEN "RTN","SDEC1",50,0) D RECGETONE^SDEC52C(.SDECY,IEN) Q "RTN","SDEC1",51,0) RECGETONEJSON(SDECY,IEN) ; This RPC returns the open recall associated with a given IEN in JSON format "RTN","SDEC1",52,0) D RECGETONEJSON^SDEC52CJSON(.SDECY,IEN) Q "RTN","SDEC1",53,0) RESGRP(SDECY,SDECDUZ,GRPIEN) ;EP SDEC CLINIC GROUP RETURN "RTN","SDEC1",54,0) D RESGRP^SDEC63(.SDECY,SDECDUZ,GRPIEN) Q "RTN","SDEC1",55,0) SAVEVVSID(RETURN,DFN,RESOURCE,APPT,VVSID) ;This RPC saves the VVS appointment ID in the SDEC APPOINTMENT file "RTN","SDEC1",56,0) D SAVEVVSID^SDECVVS(.RETURN,DFN,RESOURCE,APPT,VVSID) Q "RTN","SDEC1",57,0) SEQ(RE1,DF1,CL1,PDATE,RTYPE,SRR) ; RPC: SDEC CONTACT SEQUENCE "RTN","SDEC1",58,0) D SEQ^SDECCON(.RE1,DF1,CL1,PDATE,RTYPE,SRR) Q "RTN","SDEC1",59,0) SEQ1(RTU,REQT,RIEN) ; RPC: SDEC CONTACT SEQUENCE SINGLE "RTN","SDEC1",60,0) D SEQ1^SDECCON(.RTU,REQT,RIEN) Q "RTN","SDEC1",61,0) UPDATE(RTT,IEN,CONDT,CTYPE,COMM,DTEN) ; RPC: SDEC CONTACT UPDATE "RTN","SDEC1",62,0) D UPDATE^SDECCON(.RTT,IEN,CONDT,CTYPE,COMM,DTEN) Q "RTN","SDEC1",63,0) VVSPROSEARCH(VVSPROVIDERS,SEARCHSTRING) ;SEARCH PROVIDERS & GET DATA TO MAKE VIDEO VISIT SERVICE (VVS) APPT "RTN","SDEC1",64,0) D VVSPROSEARCH^SDECVVS(.VVSPROVIDERS,SEARCHSTRING) Q "RTN","SDEC1",65,0) JSONVVSMAKEINFO(VVSMAKEINFO,PATIENTIEN,CLINICIEN) ;GET INFO TO MAKE A VIDEO VISIT WEB SERVICE (VVS) CALL "RTN","SDEC1",66,0) D GETVVSMAKEINFO^SDECVVSJSON(.VVSMAKEINFO,PATIENTIEN,CLINICIEN) Q "RTN","SDEC1",67,0) JSONVVSPRVSRCH(SDEC,SRCHSTR) ;EP RPC: SDEC SEARCH VVS PROVIDERS JSON "RTN","SDEC1",68,0) D JSONPRVLIST^SDECPRVSRCHJSON(.SDEC,SRCHSTR) Q "RTN","SDEC1",69,0) ; "RTN","SDEC1",70,0) Q "RTN","SDEC32") 0^9^B127199073^B127218939 "RTN","SDEC32",1,0) SDEC32 ;ALB/SAT,DMR - VISTA SCHEDULING RPCS ;JUL 26, 2017 "RTN","SDEC32",2,0) ;;5.3;Scheduling;**627,643,642,658,665,672,679,781,796,797**;Aug 13, 1993;Build 8 "RTN","SDEC32",3,0) ;;Per VHA Directive 6402, this routine should not be modified "RTN","SDEC32",4,0) Q "RTN","SDEC32",5,0) ; "RTN","SDEC32",6,0) ; "RTN","SDEC32",7,0) ERROR ; "RTN","SDEC32",8,0) D ERR("VistA Error") "RTN","SDEC32",9,0) Q "RTN","SDEC32",10,0) ; "RTN","SDEC32",11,0) ERR(SDECERR) ;Error processing "RTN","SDEC32",12,0) S SDECI=SDECI+1 "RTN","SDEC32",13,0) S ^TMP("SDEC",$J,SDECI)=$C(31) "RTN","SDEC32",14,0) Q "RTN","SDEC32",15,0) ; "RTN","SDEC32",16,0) HOSPLOC(SDECY,SDECP,MAXREC,LSUB) ;return HOSPITAL LOCATIONs "RTN","SDEC32",17,0) ;HOSPLOC(SDECY) external parameter tag is in SDEC "RTN","SDEC32",18,0) ;INPUT: "RTN","SDEC32",19,0) ; SDECP - (optional) Partial name text "RTN","SDEC32",20,0) ; MAXREC - (optional) Max number of records to return "RTN","SDEC32",21,0) ; LSUB - (optional) subscripts from last call to pick up where left off "RTN","SDEC32",22,0) ;RETURN: "RTN","SDEC32",23,0) ;Global Array in which each array entry "RTN","SDEC32",24,0) ;contains HOSPITAL LOCATION data separated by ^: "RTN","SDEC32",25,0) ; 1. HOSPITAL_LOCATION_ID "RTN","SDEC32",26,0) ; 2. HOSPITAL_LOCATION "RTN","SDEC32",27,0) ; 3. DEFAULT_PROVIDER "RTN","SDEC32",28,0) ; 4. STOP_CODE_NUMBER "RTN","SDEC32",29,0) ; 5. INACTIVATE_DATE "RTN","SDEC32",30,0) ; 6. REACTIVATE_DATE "RTN","SDEC32",31,0) ; 7. LASTSUB "RTN","SDEC32",32,0) N SDECI,SDECIEN,SDECNOD,SDECNOD1,SDECNAM,SDECINA,SDECREA,SDECSCOD "RTN","SDEC32",33,0) N SDECIEN1,SDECPRV,SDDUP,SDNAM "RTN","SDEC32",34,0) N LASTSUB,X "RTN","SDEC32",35,0) K ^TMP("SDEC",$J) "RTN","SDEC32",36,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDEC32",37,0) S SDECI=0 "RTN","SDEC32",38,0) S ^TMP("SDEC",$J,SDECI)="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030DEFAULT_PROVIDER^T00030STOP_CODE_NUMBER^D00020INACTIVATE_DATE^D00020REACTIVATE_DATE^T00030LASTSUB"_$C(30) "RTN","SDEC32",39,0) ; "RTN","SDEC32",40,0) S SDECP=$G(SDECP) "RTN","SDEC32",41,0) S MAXREC=+$G(MAXREC) "RTN","SDEC32",42,0) S LSUB=$G(LSUB) "RTN","SDEC32",43,0) S:LSUB="" SDECNAM=$S(SDECP'="":$$GETSUB^SDEC56(SDECP),1:"") "RTN","SDEC32",44,0) S:LSUB'="" SDECNAM=$$GETSUB^SDEC56($P(LSUB,"|",1)) "RTN","SDEC32",45,0) F S SDECNAM=$O(^SC("B",SDECNAM)) Q:(SDECP'="")&(SDECNAM'[SDECP) Q:SDECNAM="" D Q:(+MAXREC)&(SDECI'0 D Q:(+MAXREC)&(SDECI'0 "RTN","SDEC32",48,0) .. Q:'$D(^SC(+SDECIEN,0)) "RTN","SDEC32",49,0) .. Q:$$INACTIVE(+SDECIEN) "RTN","SDEC32",50,0) .. Q:+$$GET1^DIQ(44,SDECIEN_",",50.01,"I")=1 ;OOS? "RTN","SDEC32",51,0) .. S SDECINA=$$GET1^DIQ(44,SDECIEN_",",2505) ;INACTIVATE "RTN","SDEC32",52,0) .. S SDECREA=$$GET1^DIQ(44,SDECIEN_",",2506) ;REACTIVATE "RTN","SDEC32",53,0) .. S SDECNOD=^SC(SDECIEN,0) "RTN","SDEC32",54,0) .. Q:$D(SDDUP(+SDECIEN)) "RTN","SDEC32",55,0) .. S SDDUP(+SDECIEN)="" "RTN","SDEC32",56,0) .. S SDNAM=$P(SDECNOD,U) "RTN","SDEC32",57,0) .. S SDECSCOD=$$GET1^DIQ(44,SDECIEN_",",8) ;STOP CODE "RTN","SDEC32",58,0) .. ;Calculate default provider "RTN","SDEC32",59,0) .. S SDECPRV="" "RTN","SDEC32",60,0) .. I $D(^SC(SDECIEN,"PR")) D "RTN","SDEC32",61,0) ... S SDECIEN1=0 F S SDECIEN1=$O(^SC(SDECIEN,"PR",SDECIEN1)) Q:'+SDECIEN1 Q:SDECPRV]"" D "RTN","SDEC32",62,0) .... S SDECNOD1=$G(^SC(SDECIEN,"PR",SDECIEN1,0)) "RTN","SDEC32",63,0) .... S:$P(SDECNOD1,U,2)="1" SDECPRV=$$GET1^DIQ(200,$P(SDECNOD1,U),.01) "RTN","SDEC32",64,0) .... Q "RTN","SDEC32",65,0) ... Q "RTN","SDEC32",66,0) .. S LASTSUB=SDECNAM_"|"_SDECIEN "RTN","SDEC32",67,0) .. S SDECI=SDECI+1 "RTN","SDEC32",68,0) .. S ^TMP("SDEC",$J,SDECI)=SDECIEN_U_SDNAM_U_SDECPRV_U_SDECSCOD_U_SDECINA_U_SDECREA_U_LASTSUB_$C(30) "RTN","SDEC32",69,0) .. Q "RTN","SDEC32",70,0) I SDECNAM="",SDECIEN="" S $P(^TMP("SDEC",$J,SDECI),U,7)="" ;clear lastsub for last entry if finished "RTN","SDEC32",71,0) S ^TMP("SDEC",$J,SDECI)=^TMP("SDEC",$J,SDECI)_$C(31) "RTN","SDEC32",72,0) K SDDUP "RTN","SDEC32",73,0) Q "RTN","SDEC32",74,0) ; "RTN","SDEC32",75,0) CLINSET(SDECY,SDNOSLOT,SDIENS,SDECP,SDNOLET,MAXREC) ;Returns CLINIC SETUP PARAMETERS for clinics that are active in the HOSPITAL LOCATION file "RTN","SDEC32",76,0) ;CLINSET(SDECY,SDNOSLOT,SDIENS,SDECP,SDNOLET) external parameter tag is in SDEC "RTN","SDEC32",77,0) ;INPUT: "RTN","SDEC32",78,0) ; SDNOSLOT - no slots flag - 0=return availability 1=do not return availability "RTN","SDEC32",79,0) ; SDIENS - IENs for individual hospital locations separated by pipes "RTN","SDEC32",80,0) ; SDNOLET - flag to include clinics with no Recall Letter defined "RTN","SDEC32",81,0) ; in RECALL REMINDERS LETTERS file "RTN","SDEC32",82,0) ; 0 = yes (include all clinics including those with no Recall Letter "RTN","SDEC32",83,0) ; defined) [default] "RTN","SDEC32",84,0) ; 1 = no (only return clinics with a Recall Letter "RTN","SDEC32",85,0) ; defined) "RTN","SDEC32",86,0) ;Returns CLINIC SETUP PARAMETERS file entries for clinics which "RTN","SDEC32",87,0) ;are active in ^SC (#44) "RTN","SDEC32",88,0) ;MGH Added SDIENS as input parameter to for hospital location IENs "RTN","SDEC32",89,0) ;MGH Added SDECP for partial name lookup "RTN","SDEC32",90,0) ;RETURN "RTN","SDEC32",91,0) ; Global Array in which each array entry contains the following Clinic data separated by ^: "RTN","SDEC32",92,0) ; 1. HOSPITAL_LOCATION_ID "RTN","SDEC32",93,0) ; 2. HOSPITAL_LOCATION "RTN","SDEC32",94,0) ; 3. CREATE_VISIT "RTN","SDEC32",95,0) ; 4. VISIT_SERVICE_CATEGORY "RTN","SDEC32",96,0) ; 5. MULTIPLE_CLINIC_CODES_USED? "RTN","SDEC32",97,0) ; 6. VISIT_PROVIDER_REQUIRED "RTN","SDEC32",98,0) ; 7. GENERATE_PCCPLUS_FORMS? "RTN","SDEC32",99,0) ; 8. MAX_OVERBOOKS "RTN","SDEC32",100,0) ; 9. SDECDAT "RTN","SDEC32",101,0) ;10. SDECDATN "RTN","SDEC32",102,0) ;11. APPTLEN - 1912 Appointment Length Numeric 10-240 "RTN","SDEC32",103,0) ;12. VAPPTLEN "RTN","SDEC32",104,0) ;13. SLOTS "RTN","SDEC32",105,0) ;14. PRIVUSERPRESENT_BOOL "RTN","SDEC32",106,0) ;15. PROTECTED "RTN","SDEC32",107,0) ;16. HOUR_DISPLAY_BEGIN - 1914 Hour Clinic Display Begins "RTN","SDEC32",108,0) ;17. DISPLAY_INCREMENTS - 1917 Display increments per hour "RTN","SDEC32",109,0) ; 1=60-MIN "RTN","SDEC32",110,0) ; 2=30-MIN "RTN","SDEC32",111,0) ; 4=15-MIN "RTN","SDEC32",112,0) ; 3=20-MIN "RTN","SDEC32",113,0) ; 6=10-MIN "RTN","SDEC32",114,0) ;18. HOLIDAYS - 1918.5 Schedule on Holidays? Y=YES "RTN","SDEC32",115,0) ;19. SPECIAL - 1910 SPECIAL INSTRUCTIONS separated by $C(13,10) "RTN","SDEC32",116,0) ;20. CLINIC_STOP - 8 Stop code Number pointer to CLINIC STOP in file 40.7 "RTN","SDEC32",117,0) ;21. ABBREVIATION - 1 Abbrevation "RTN","SDEC32",118,0) ;22. not used ?? "RTN","SDEC32",119,0) ;23. DEFAULT_VIEW - Scheduling default view "RTN","SDEC32",120,0) ;24. VVC Indicator - Inicator if this clinic is considered a VVC clinic (1=Yes 0=No) "RTN","SDEC32",121,0) N SDA,SDAPLEN,SDAR,SDDATA,SDF,SDFIELDS,SDI,SDJ,SDK,SDSLOTS,SDVAPL,SDECI,SDECIEN,SDECNOD,SDECNAM,SDECINA,SDECREA,SDTMP ;alb/sat 665 - add SDF "RTN","SDEC32",122,0) N SDECCRV,SDECDAT,SDECDATN,SDECVSC,SDECMULT,SDECREQ,SDECPCC,SDECMOB,SDECHPRV,SDECPROT,SDECNAM,SDCNT,SDL,SDMAX ;alb/sat 665 - add vars "RTN","SDEC32",123,0) N SDARR1,SDREF,SDXT,SDV ;alb/sat 672 "RTN","SDEC32",124,0) K ^TMP("SDEC",$J) "RTN","SDEC32",125,0) S (SDCNT,SDMAX)=0 "RTN","SDEC32",126,0) S SDF="" "RTN","SDEC32",127,0) S SDV="" ;alb/sat 672 "RTN","SDEC32",128,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDEC32",129,0) S SDECI=0 "RTN","SDEC32",130,0) ; 1 2 3 4 "RTN","SDEC32",131,0) S SDTMP="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030CREATE_VISIT^T00030VISIT_SERVICE_CATEGORY" "RTN","SDEC32",132,0) ; 5 6 7 "RTN","SDEC32",133,0) S SDTMP=SDTMP_"^T00030MULTIPLE_CLINIC_CODES_USED?^T00030VISIT_PROVIDER_REQUIRED^T00030GENERATE_PCCPLUS_FORMS?" "RTN","SDEC32",134,0) ; 8 9 10 11 12 13 14 "RTN","SDEC32",135,0) S SDTMP=SDTMP_"^T00030MAX_OVERBOOKS^T00030SDECDAT^T00030SDECDATN^T00030APPTLEN^T00030VAPPTLEN^T00030SLOTS^B00001PRIVUSERPRESENT_BOOL" "RTN","SDEC32",136,0) ; 15 16 17 18 "RTN","SDEC32",137,0) S SDTMP=SDTMP_"^B00001PROTECTED^T00030HOUR_DISPLAY_BEGIN^T00030DISPLAY_INCREMENTS^T00030HOLIDAYS^T00030SPECIAL^T00030CLINIC_STOP" "RTN","SDEC32",138,0) ; 21 22 23 "RTN","SDEC32",139,0) S SDTMP=SDTMP_"^T00030ABBR^T00030MORE^T00030DEFAULT_VIEW" ;alb/sat 672 - add DEFAULT_VIEW "RTN","SDEC32",140,0) ; 24 "RTN","SDEC32",141,0) S SDTMP=SDTMP_"^T00030VVC_CLINIC" ; VVC_Indicator "RTN","SDEC32",142,0) S ^TMP("SDEC",$J,SDECI)=SDTMP_$C(30) "RTN","SDEC32",143,0) ; "RTN","SDEC32",144,0) S (SDECDAT,SDECDATN)="" "RTN","SDEC32",145,0) S SDNOSLOT=$G(SDNOSLOT) "RTN","SDEC32",146,0) S SDNOLET=$G(SDNOLET) "RTN","SDEC32",147,0) S MAXREC=$G(MAXREC,50) "RTN","SDEC32",148,0) ;MGH change made for individual locations "RTN","SDEC32",149,0) I $G(SDIENS) D "RTN","SDEC32",150,0) .F SDK=1:1:$L(SDIENS,"|") D "RTN","SDEC32",151,0) ..S SDECIEN=$P(SDIENS,"|",SDK) "RTN","SDEC32",152,0) ..D PROCESS(SDECIEN) "RTN","SDEC32",153,0) ;MGH change made for partial name lookup "RTN","SDEC32",154,0) I $G(SDECP)'="" D "RTN","SDEC32",155,0) .;alb/sat 672 - begin modification; separate string and numeric lookup "RTN","SDEC32",156,0) .S (SDECNAM,SDXT)=$$GETSUB^SDECU(SDECP) "RTN","SDEC32",157,0) .;abbreviation as string "RTN","SDEC32",158,0) .S SDF="ABBRSTR" D "RTN","SDEC32",159,0) ..S SDREF="C" D PART Q "RTN","SDEC32",160,0) .;abbreviation as numeric "RTN","SDEC32",161,0) .S SDF="ABBRNUM",SDECNAM=SDXT_" " D "RTN","SDEC32",162,0) ..S SDREF="C" D PART Q "RTN","SDEC32",163,0) .;name as string "RTN","SDEC32",164,0) .S SDF="FULLSTR",SDECNAM=SDXT D "RTN","SDEC32",165,0) ..S SDREF="B" D PART Q "RTN","SDEC32",166,0) .;name as numeric "RTN","SDEC32",167,0) .S SDF="FULLNUM",SDECNAM=SDXT_" " D "RTN","SDEC32",168,0) ..S SDREF="B" D PART Q "RTN","SDEC32",169,0) .;alb/sat 672 - end modification; separate string and numeric lookup "RTN","SDEC32",170,0) I $G(SDIENS)=""&($G(SDECP)="") S SDECIEN=0 F S SDECIEN=$O(^SC(SDECIEN)) Q:SDECIEN'>0 D "RTN","SDEC32",171,0) .D PROCESS(SDECIEN) "RTN","SDEC32",172,0) S SDL=-1 F S SDL=$O(SDAR(SDL)) Q:SDL="" D "RTN","SDEC32",173,0) .S SDI="" F S SDI=$O(SDAR(SDL,SDI)) Q:SDI="" D "RTN","SDEC32",174,0) ..S SDJ="" F S SDJ=$O(SDAR(SDL,SDI,SDJ)) Q:SDJ="" D "RTN","SDEC32",175,0) ...S SDTMP=SDAR(SDL,SDI,SDJ) "RTN","SDEC32",176,0) ...S $P(SDTMP,U,22)=$S(+SDMAX:1,1:0) "RTN","SDEC32",177,0) ...S SDECI=SDECI+1 "RTN","SDEC32",178,0) ...S ^TMP("SDEC",$J,SDECI)=SDTMP_$C(30) "RTN","SDEC32",179,0) S ^TMP("SDEC",$J,SDECI)=^TMP("SDEC",$J,SDECI)_$C(31) "RTN","SDEC32",180,0) Q "RTN","SDEC32",181,0) PART ;partial name lookup ;alb/sat 672 "RTN","SDEC32",182,0) Q:SDREF="" "RTN","SDEC32",183,0) F S SDECNAM=$O(^SC(SDREF,SDECNAM)) Q:SDECNAM'[SDECP D I SDCNT'0 "RTN","SDEC32",225,0) S SDECPROT=$G(^SC(+SDECIEN,"SDPROT"))="Y" "RTN","SDEC32",226,0) S SDSP="" S SDI=0 F S SDI=$O(^SC(+SDECIEN,"SI",SDI)) Q:SDI'>0 S SDI1=$G(^SC(+SDECIEN,"SI",SDI,0)) S:SDI1'="" SDSP=$S(SDSP'="":SDSP_$C(13,10),1:"")_SDI1 "RTN","SDEC32",227,0) S:SDECNAM'="" SDV=$$GET^XPAR("PKG.SCHEDULING","SDEC VS GUI CLINIC VIEW",SDECNAM,"B") ;alb/sat 672 "RTN","SDEC32",228,0) S SDV=$S(SDV'="":$P(SDV,U,1),1:"W") ;alb/sat 672 "RTN","SDEC32",229,0) S SDVVC=0 "RTN","SDEC32",230,0) S SDCRSTOP=@SDA@(2503,"I") ;CREDIT STOP CODE NUMBER "RTN","SDEC32",231,0) I SDSTOP S SDVVC=$$VVCSTPCD(SDSTOP) "RTN","SDEC32",232,0) I 'SDVVC,SDCRSTOP S SDVVC=$$VVCSTPCD(SDCRSTOP) "RTN","SDEC32",233,0) ; 1 2 3 4 5 6 7 8 "RTN","SDEC32",234,0) S SDTMP=SDECIEN_U_SDECNAM_U_SDECCRV_U_SDECVSC_U_SDECMULT_U_SDECREQ_U_SDECPCC_U_SDECMOB "RTN","SDEC32",235,0) ; 9 10 11 12 13 14 15 "RTN","SDEC32",236,0) S SDTMP=SDTMP_U_SDECDAT_U_SDECDATN_U_+SDAPLEN_U_SDVAPL_U_SDSLOTS_U_SDECHPRV_U_SDECPROT "RTN","SDEC32",237,0) ; 16 17 18 19 20 21 22 23 "RTN","SDEC32",238,0) S SDTMP=SDTMP_U_SDHDB_U_SDDI_U_SDH_U_SDSP_U_SDSTOP_U_SDECABR_U_U_SDV ;alb/sat 672 - add SDV "RTN","SDEC32",239,0) ; 24 "RTN","SDEC32",240,0) S SDTMP=SDTMP_U_SDVVC ; ??? - add SDVVC "RTN","SDEC32",241,0) S SDAR(SDF["FULL",SDECNAM,SDECIEN)=SDTMP "RTN","SDEC32",242,0) S SDCNT=SDCNT+1 "RTN","SDEC32",243,0) Q "RTN","SDEC32",244,0) CHK(SDECP,SDECIEN) ;alb/sat 665 - stop if 'this' record found in abbreviations ;alb/sat 672 - removed "RTN","SDEC32",245,0) Q "RTN","SDEC32",246,0) N FND,SDR,SDX "RTN","SDEC32",247,0) S FND=0 "RTN","SDEC32",248,0) S SDX=$$GETSUB^SDEC56(SDECP) "RTN","SDEC32",249,0) F S SDX=$O(^SC("C",SDX)) Q:SDX="" Q:SDX'[SDECP D Q:+FND "RTN","SDEC32",250,0) .S SDR=0 F S SDR=$O(^SC("C",SDX,SDR)) Q:'+SDR S FND=SDR=SDECIEN Q:+FND "RTN","SDEC32",251,0) Q FND "RTN","SDEC32",252,0) ; "RTN","SDEC32",253,0) ; "RTN","SDEC32",254,0) GETSLOTS(SDDATA) ;get slots - NUMBER OF PATIENTS in the AVAILABILITY multiple of file 44 "RTN","SDEC32",255,0) ;INPUT: "RTN","SDEC32",256,0) ; SDDATA - array from GETS^DIQ against file 44 above to collect timeslots from "RTN","SDEC32",257,0) N SDI,SDDT,SDSLOTS "RTN","SDEC32",258,0) S SDSLOTS="" "RTN","SDEC32",259,0) S SDI="" F S SDI=$O(SDDATA(44.004,SDI)) Q:SDI="" D "RTN","SDEC32",260,0) .S SDDT=$P(SDI,",",2) ;get date "RTN","SDEC32",261,0) .S SDDT=SDDT_"."_SDDATA(44.004,SDI,.01,"I") ;get time "RTN","SDEC32",262,0) .S SDDT=$$FMTE^XLFDT(SDDT) "RTN","SDEC32",263,0) .S SDSLOTS=$S(SDSLOTS'="":SDSLOTS_"|",1:"")_SDDT_";;"_SDDATA(44.004,SDI,1,"E") "RTN","SDEC32",264,0) Q SDSLOTS "RTN","SDEC32",265,0) ; "RTN","SDEC32",266,0) INACTIVE(SDCL,SDDT) ;determine if clinic is active "RTN","SDEC32",267,0) ; X=0=ACTIVE "RTN","SDEC32",268,0) ; X=1=INACTIVE "RTN","SDEC32",269,0) N SDNODI,N21,N25,X "RTN","SDEC32",270,0) S SDDT=$G(SDDT) I SDDT="" S SDDT=DT "RTN","SDEC32",271,0) S SDDT=$P(SDDT,".",1) "RTN","SDEC32",272,0) S X=1 "RTN","SDEC32",273,0) S SDNODI=$G(^SC(SDCL,"I")) "RTN","SDEC32",274,0) Q:SDNODI="" 0 "RTN","SDEC32",275,0) S N21=$P(SDNODI,U,1) ;inactive date/time "RTN","SDEC32",276,0) S N25=$P(SDNODI,U,2) ;reactive date/time "RTN","SDEC32",277,0) I (N21="") S X=0 Q X "RTN","SDEC32",278,0) I (N21'="")&(N21>SDDT) S X=0 Q X "RTN","SDEC32",279,0) I (N25'="")&(N25'>SDDT) S X=0 Q X "RTN","SDEC32",280,0) Q X "RTN","SDEC32",281,0) ; "RTN","SDEC32",282,0) PRIV(SDECY,CLINIEN,USER) ;IS this USER in the PRIVILEGED USER multiple for the clinic "RTN","SDEC32",283,0) ;INPUT: "RTN","SDEC32",284,0) ; CLINIEN - pointer to HOSPITAL LOCATION file 44 "RTN","SDEC32",285,0) ; USER - pointer to NEW PERSON file 200 "RTN","SDEC32",286,0) ;RETURN: "RTN","SDEC32",287,0) ; A single boolean entry indicating that the USER is a PRIVILEGED USER for the clinic. "RTN","SDEC32",288,0) ; RETURNCODE - 0=NO; 1=YES; -1=error "RTN","SDEC32",289,0) ; MESSAGE "RTN","SDEC32",290,0) N SDRET "RTN","SDEC32",291,0) S SDECY="^TMP(""SDEC32"","_$J_",""PRIV"")" "RTN","SDEC32",292,0) K @SDECY "RTN","SDEC32",293,0) S @SDECY@(0)="T00030RETURNCODE^MESSAGE"_$C(30) "RTN","SDEC32",294,0) S CLINIEN=$G(CLINIEN) "RTN","SDEC32",295,0) I (CLINIEN="")!('$D(^SC(CLINIEN,0))) S @SDECY@(1)="-1^Invalid clinic ID."_$C(30,31) Q "RTN","SDEC32",296,0) S USER=$G(USER) "RTN","SDEC32",297,0) I (USER="")!('$D(^VA(200,USER,0))) S @SDECY@(1)="-1^Invalid user ID."_$C(30,31) Q "RTN","SDEC32",298,0) S SDRET=$D(^SC(CLINIEN,"SDPRIV",USER,0)) "RTN","SDEC32",299,0) S $P(SDRET,U,2)=$S(SDRET=1:"YES",1:"NO") "RTN","SDEC32",300,0) S @SDECY@(1)=SDRET_$C(30,31) "RTN","SDEC32",301,0) Q "RTN","SDEC32",302,0) ; "RTN","SDEC32",303,0) BOOKHLDY(SDECY,SDECCL) ; Returns can book on holiday flag for a clinic. 12/1/17 wtc 679 "RTN","SDEC32",304,0) ; "RTN","SDEC32",305,0) ; Returns value of field 1918.5 in file #44 "RTN","SDEC32",306,0) ; "RTN","SDEC32",307,0) ; SDECY = return value "RTN","SDEC32",308,0) ; SDECCL = pointer to file #44 "RTN","SDEC32",309,0) ; "RTN","SDEC32",310,0) S SDECY="" ; "RTN","SDEC32",311,0) Q:$G(SDECCL)="" ; "RTN","SDEC32",312,0) S SDECY=$P($G(^SC(SDECCL,"SL")),"^",8) ; "RTN","SDEC32",313,0) Q ; "RTN","SDEC32",314,0) ; "RTN","SDEC32",315,0) VVCSTPCD(STOPCD) ; "RTN","SDEC32",316,0) ; Called from PROCES tag above "RTN","SDEC32",317,0) ; "RTN","SDEC32",318,0) ;Input: "RTN","SDEC32",319,0) ; STOPCD - a stop code "RTN","SDEC32",320,0) ; "RTN","SDEC32",321,0) ;Return: "RTN","SDEC32",322,0) ; 1 = Stop code is found in the SDEC SETTING file (#409.98) field 7 VVC STOP CODE "RTN","SDEC32",323,0) Q:'$G(STOPCD) "RTN","SDEC32",324,0) N RETURN,STOP "RTN","SDEC32",325,0) ; "RTN","SDEC32",326,0) S RETURN=0 "RTN","SDEC32",327,0) S STOP="" S STOP=$$GET1^DIQ(40.7,STOPCD,1) "RTN","SDEC32",328,0) I STOP>0 D "RTN","SDEC32",329,0) .I $D(^SDEC(409.98,1,3,"B",STOP)) S RETURN=1 "RTN","SDEC32",330,0) Q RETURN "RTN","SDEC52B") 0^10^B22077700^B21704341 "RTN","SDEC52B",1,0) SDEC52B ;ALB/MGD - VISTA SCHEDULING RPCS ;JAN 15, 2016 "RTN","SDEC52B",2,0) ;;5.3;Scheduling;**627,796,797**;Aug 13, 1993;Build 8 "RTN","SDEC52B",3,0) ;;Per VHA Directive 6402, this routine should not be modified "RTN","SDEC52B",4,0) ; "RTN","SDEC52B",5,0) ; Reference to ^VA(200 in ICR #10060 "RTN","SDEC52B",6,0) ; "RTN","SDEC52B",7,0) Q "RTN","SDEC52B",8,0) ; "RTN","SDEC52B",9,0) RECAPGET(SDECY) ; GET entries from the RECALL REMINDERS APPT TYPE file 403.51 "RTN","SDEC52B",10,0) ;RECAPGET(SDECY) external parameter tag is in SDEC "RTN","SDEC52B",11,0) ;INPUT: none "RTN","SDEC52B",12,0) ;RETURN: "RTN","SDEC52B",13,0) ; Successful Return: "RTN","SDEC52B",14,0) ; Global Array in which each array entry contains Recall Reminders Appt "RTN","SDEC52B",15,0) ; type names from the RECALL REMINDERS APPT TYPE file 403.51 "RTN","SDEC52B",16,0) ; Data is separated by ^: "RTN","SDEC52B",17,0) ; 1. RECALL REMINDERS APPT TYPE ien "RTN","SDEC52B",18,0) ; 2. RECALL REMINDERS APPT TYPE name "RTN","SDEC52B",19,0) ; Caught Exception Return: "RTN","SDEC52B",20,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDEC52B",21,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC52B",22,0) ; Unexpected Exception Return: "RTN","SDEC52B",23,0) ; Handled by the RPC Broker. "RTN","SDEC52B",24,0) ; M errors are trapped by the use of M and Kernel error handling. "RTN","SDEC52B",25,0) ; The RPC execution stops and the RPC Broker sends the error generated "RTN","SDEC52B",26,0) ; text back to the client. "RTN","SDEC52B",27,0) ; "RTN","SDEC52B",28,0) N NAME,SDECI,SDI "RTN","SDEC52B",29,0) S SDECI=0 "RTN","SDEC52B",30,0) K ^TMP("SDEC52",$J,"RECAPGET") "RTN","SDEC52B",31,0) S SDECY="^TMP(""SDEC52"","_$J_",""RECAPGET"")" "RTN","SDEC52B",32,0) ; data header "RTN","SDEC52B",33,0) S @SDECY@(SDECI)="T00030RRAPPTYP^T00030RRAPPTYPN"_$C(30) "RTN","SDEC52B",34,0) S SDI=0 F S SDI=$O(^SD(403.51,SDI)) Q:SDI'>0 D "RTN","SDEC52B",35,0) .S NAME=$$GET1^DIQ(403.51,SDI_",",.01) ; $P($G(^SD(403.51,SDI,0)),U,1) "RTN","SDEC52B",36,0) .S SDECI=SDECI+1 S @SDECY@(SDECI)=SDI_U_NAME_$C(30) "RTN","SDEC52B",37,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDEC52B",38,0) Q "RTN","SDEC52B",39,0) ; "RTN","SDEC52B",40,0) RECPRGET(SDECY,RECINACT,SDECP,MAXREC,LASTSUB) ; GET entries from the RECALL REMINDERS PROVIDERS file 403.54 "RTN","SDEC52B",41,0) ;RECAPGET(SDECY,RECINACT) external parameter tag is in SDEC "RTN","SDEC52B",42,0) ;INPUT: "RTN","SDEC52B",43,0) ; RECINACT - flag to include inactive providers "RTN","SDEC52B",44,0) ; SDECP - (optional) Partial name text "RTN","SDEC52B",45,0) ; MAXREC - (optional) Max records returned "RTN","SDEC52B",46,0) ; LASTSUB - (optional) last subscripts from previous call "RTN","SDEC52B",47,0) ;RETURN: "RTN","SDEC52B",48,0) ; Successful Return: "RTN","SDEC52B",49,0) ; Global Array in which each array entry contains data from RECALL REMINDERS PROVIDERS file 403.54. "RTN","SDEC52B",50,0) ; Data is separated by ^: "RTN","SDEC52B",51,0) ; 1. IEN - Pointer to RECALL REMINDERS PROVIDERS file "RTN","SDEC52B",52,0) ; 2. Provider IEN - Pointer to NEW PERSON file "RTN","SDEC52B",53,0) ; 3. Provider Name - NAME from NEW PERSON file "RTN","SDEC52B",54,0) ; 4. Team ID - Pointer to RECALL REMINDERS TEAM file 403.55 "RTN","SDEC52B",55,0) ; 5. Team Name - NAME from RECALL REMINDERS TEAM file 403.55 "RTN","SDEC52B",56,0) ; 6. Division ID - Pointer to MEDICAL CENTER DIVISION file 40.8 "RTN","SDEC52B",57,0) ; 7. Division Name - NAME from MEDICAL CENTER DIVISION file 40.8 "RTN","SDEC52B",58,0) ; 8. Direct Phone - Free-Text 7-14 Characters "RTN","SDEC52B",59,0) ; 9. EXT. - Free-Text 4-20 characters "RTN","SDEC52B",60,0) ; 10. Status - Valid values are: "RTN","SDEC52B",61,0) ; ACTIVE "RTN","SDEC52B",62,0) ; INACTIVE "RTN","SDEC52B",63,0) ; 11. Security Key ID - Pointer to SECURITY KEY file 19.1 "RTN","SDEC52B",64,0) ; 12. Security Key Name - NAME from SECURITY KEY file 19.1 "RTN","SDEC52B",65,0) ; 13. LASTSUB - Subscripts from last call "RTN","SDEC52B",66,0) ; Caught Exception Return: "RTN","SDEC52B",67,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDEC52B",68,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDEC52B",69,0) ; Unexpected Exception Return: "RTN","SDEC52B",70,0) ; Handled by the RPC Broker. "RTN","SDEC52B",71,0) ; M errors are trapped by the use of M and Kernel error handling. "RTN","SDEC52B",72,0) ; The RPC execution stops and the RPC Broker sends the error generated "RTN","SDEC52B",73,0) ; text back to the client. "RTN","SDEC52B",74,0) ; "RTN","SDEC52B",75,0) N LSUB,PRVDATA,SDCNT,SDECI,SDI,SDJ,SDK,SDTMP "RTN","SDEC52B",76,0) S (SDI,SDJ,SDK)="" "RTN","SDEC52B",77,0) S (SDCNT,SDECI)=0 "RTN","SDEC52B",78,0) K ^TMP("RECDATA",$J) "RTN","SDEC52B",79,0) S RECINACT=$G(RECINACT) "RTN","SDEC52B",80,0) I RECINACT="" S RECINACT=0 "RTN","SDEC52B",81,0) K ^TMP("SDEC52",$J,"RECPRGET") "RTN","SDEC52B",82,0) S SDECY="^TMP(""SDEC52"","_$J_",""RECPRGET"")" "RTN","SDEC52B",83,0) ; data header "RTN","SDEC52B",84,0) S SDTMP="T00030RRPROVIEN^T00030PROVIEN^T00030PROVNAME^T00030TEAMID^T00030TEAMNAME^T00030DIVIEN" "RTN","SDEC52B",85,0) S SDTMP=SDTMP_"^T00030DIVNAME^T00030PTELEPHONE^T00020EXT^T00010RRPSTATUS^T00020KEYIEN^T00030KEYNAME" "RTN","SDEC52B",86,0) S SDTMP=SDTMP_"^T00030LASTSUB" "RTN","SDEC52B",87,0) S @SDECY@(SDECI)=SDTMP_$C(30) "RTN","SDEC52B",88,0) S SDECP=$G(SDECP) "RTN","SDEC52B",89,0) S MAXREC=$G(MAXREC,200) S:MAXREC="" MAXREC=200 "RTN","SDEC52B",90,0) S LASTSUB=$G(LASTSUB) "RTN","SDEC52B",91,0) I SDECP'="" D "RTN","SDEC52B",92,0) .S SDK=$S($P(LASTSUB,"|",1)'="":$$GETSUB^SDECU($P(LASTSUB,"|",1)),1:$$GETSUB^SDECU(SDECP)) "RTN","SDEC52B",93,0) .F S SDK=$O(^VA(200,"B",SDK)) Q:SDK="" Q:SDK'[SDECP D Q:SDCNT'0 D Q:SDCNT'0 D GET1PR(SDI,RECINACT,.SDCNT) Q:SDCNT'0 D GET1PR(SDI,RECINACT,.SDCNT) "RTN","SDEC52B",99,0) N PRVNAME "RTN","SDEC52B",100,0) S PRVNAME="" "RTN","SDEC52B",101,0) F S PRVNAME=$O(^TMP("RECDATA",$J,PRVNAME)) Q:PRVNAME="" D "RTN","SDEC52B",102,0) .S PRVDATA=$G(^TMP("RECDATA",$J,PRVNAME)) "RTN","SDEC52B",103,0) .S SDECI=SDECI+1 "RTN","SDEC52B",104,0) .S @SDECY@(SDECI)=PRVDATA_$C(30) "RTN","SDEC52B",105,0) .S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDEC52B",106,0) I SDCNT'0 D Q "RTN","SDEC797P",47,0) . K MES "RTN","SDEC797P",48,0) . S MES(1)=" " "RTN","SDEC797P",49,0) . S MES(2)="The BLOCK AND MOVE cancellation reason already exist in File #409.2." "RTN","SDEC797P",50,0) . S MES(3)="No Action Taken." "RTN","SDEC797P",51,0) . S MES(4)=" " "RTN","SDEC797P",52,0) . D MES^XPDUTL(.MES) "RTN","SDEC797P",53,0) I $D(SDERR) D DISPERR($G(SDERR("DIERR",1,"TEXT",1))) Q ;do not continue if error occurs "RTN","SDEC797P",54,0) ; "RTN","SDEC797P",55,0) D BMES^XPDUTL("Adding BLOCK AND MOVE entry to CANCELLATION REASONS File #409.2") "RTN","SDEC797P",56,0) S SDFDA(409.2,"+1,",.01)=SDRSN ;Cancellation Reason Name "RTN","SDEC797P",57,0) S SDFDA(409.2,"+1,",2)="C" ;'C'linic - cancellation reason type "RTN","SDEC797P",58,0) K SDERR D UPDATE^DIE("E","SDFDA","","SDERR") "RTN","SDEC797P",59,0) I $D(SDERR) D DISPERR($G(SDERR("DIERR",1,"TEXT",1))) Q ;do not continue if error occurs "RTN","SDEC797P",60,0) ; "RTN","SDEC797P",61,0) D BMES^XPDUTL("BLOCK AND MOVE successfully added to CANCELLATION REASONS File #409.2.") "RTN","SDEC797P",62,0) Q "RTN","SDEC797P",63,0) ; "RTN","SDEC797P",64,0) DISPERR(ERROR) ; display error message "RTN","SDEC797P",65,0) K MES "RTN","SDEC797P",66,0) S MES(1)=" " "RTN","SDEC797P",67,0) S MES(2)="Error while adding BLOCK AND MOVE entry to CANCELLATION REASONS File #409.2." "RTN","SDEC797P",68,0) S MES(3)="Error: "_ERROR "RTN","SDEC797P",69,0) S MES(4)=" " "RTN","SDEC797P",70,0) D MES^XPDUTL(.MES) "RTN","SDEC797P",71,0) Q "RTN","SDEC797P",72,0) ; "RTN","SDECAR") 0^4^B93128026^B91790925 "RTN","SDECAR",1,0) SDECAR ;ALB/SAT,MGD - VISTA SCHEDULING RPCS ;Apr 10, 2020@15:22 "RTN","SDECAR",2,0) ;;5.3;Scheduling;**627,642,671,745,792,797**;Aug 13, 1993;Build 8 "RTN","SDECAR",3,0) ;;Per VHA Directive 6402, this routine should not be modified "RTN","SDECAR",4,0) ; "RTN","SDECAR",5,0) Q "RTN","SDECAR",6,0) ; "RTN","SDECAR",7,0) ARCLOSE(RET,INP) ;Appointment Request Close "RTN","SDECAR",8,0) ;SD*5.3*745 replace external 'INP...' due to XINDEX issue. Parameters are then rolled into the INP "RTN","SDECAR",9,0) ; array. Allow EA as new disposition code. "RTN","SDECAR",10,0) ;ARCLOSE(RET,S1,S2,S3,S4) external parameter tag in SDEC "RTN","SDECAR",11,0) ; INP - Input parameters array "RTN","SDECAR",12,0) ; INP(1) - Request ID - Pointer to SDEC APPT REQUEST file "RTN","SDECAR",13,0) ; INP(2) - Disposition "RTN","SDECAR",14,0) ; INP(3) - User Id - Pointer to NEW PERSON file "RTN","SDECAR",15,0) ; INP(4) - Date Dispositioned in external form "RTN","SDECAR",16,0) N MI,ARDISP,ARDISPBY,ARDISPDT,ARFDA,ARIEN,ARMSG,ARRET "RTN","SDECAR",17,0) S RET="I00020ERRORID^T00256ERRORTEXT"_$C(30) "RTN","SDECAR",18,0) ;validate IEN "RTN","SDECAR",19,0) S ARIEN=$G(INP(1)) I ARIEN="" S RET=RET_"-1^Missing IEN"_$C(30,31) Q "RTN","SDECAR",20,0) ;validate DISPOSITION "RTN","SDECAR",21,0) S ARDISP=$G(INP(2)) "RTN","SDECAR",22,0) I ARDISP="" S RET=RET_"-1^Missing value for DISPOSITION"_$C(30,31) Q "RTN","SDECAR",23,0) ;MC:MRTC PARENT CLOSED "RTN","SDECAR",24,0) ; VSE-1220: Re-mapped the Dispositions to their corresponding pointer value "RTN","SDECAR",25,0) S:ARDISP="DEATH"!(ARDISP="D") ARDISP=1 "RTN","SDECAR",26,0) S:ARDISP="REMOVED/NON-VA CARE"!(ARDISP="NC") ARDISP=2 "RTN","SDECAR",27,0) S:ARDISP="REMOVED/SCHEDULED-ASSIGNED"!(ARDISP="SA") ARDISP=3 "RTN","SDECAR",28,0) S:ARDISP="REMOVED/VA CONTRACT CARE"!(ARDISP="CC") ARDISP=4 "RTN","SDECAR",29,0) S:ARDISP="REMOVED/NO LONGER NECESSARY"!(ARDISP="NN") ARDISP=5 "RTN","SDECAR",30,0) S:ARDISP="ENTERED IN ERROR"!(ARDISP="ER") ARDISP=6 "RTN","SDECAR",31,0) S:ARDISP="TRANSFERRED TO EWL"!(ARDISP="TR") ARDISP=7 "RTN","SDECAR",32,0) S:ARDISP="CHANGED CLINIC"!(ARDISP="CL") ARDISP=8 "RTN","SDECAR",33,0) S:ARDISP="MRTC PARENT CLOSED"!(ARDISP="MC") ARDISP=9 "RTN","SDECAR",34,0) S:ARDISP="REMOVED/EXTERNAL APP"!(ARDISP="EA") ARDISP=10 ;* 745 "RTN","SDECAR",35,0) S:ARDISP="FAILURE TO RESPOND" ARDISP=11 "RTN","SDECAR",36,0) I '+ARDISP!((ARDISP<1)!(ARDISP>11)) D Q "RTN","SDECAR",37,0) .S RET=RET_"-1^Invalid value for DISPOSITION"_$C(30,31) "RTN","SDECAR",38,0) ;validate DISPOSITIONED BY "RTN","SDECAR",39,0) S ARDISPBY=$G(INP(3),DUZ) "RTN","SDECAR",40,0) I '+ARDISPBY S ARDISPBY=$O(^VA(200,"B",ARDISPBY,0)) "RTN","SDECAR",41,0) I '$D(^VA(200,+ARDISPBY,0)) S RET=RET_"-1^Invalid 'DISPOSITIONED BY' user"_$C(30,31) Q "RTN","SDECAR",42,0) ;validate DATE DISPOSITIONED "RTN","SDECAR",43,0) S ARDISPDT=$G(INP(4),DT) I ARDISPDT'="" S %DT="" S X=ARDISPDT D ^%DT S ARDISPDT=Y "RTN","SDECAR",44,0) I Y=-1 S RET=RET_"-1^Invalid 'DATE DISPOSITIONED'"_$C(30,31) Q "RTN","SDECAR",45,0) S ARFDA=$NA(ARFDA($$FNUM,ARIEN_",")) "RTN","SDECAR",46,0) S @ARFDA@(19)=ARDISPDT "RTN","SDECAR",47,0) S @ARFDA@(20)=ARDISPBY "RTN","SDECAR",48,0) S @ARFDA@(21)=ARDISP "RTN","SDECAR",49,0) S @ARFDA@(23)="C" "RTN","SDECAR",50,0) D UPDATE^DIE("","ARFDA","ARRET","ARMSG") "RTN","SDECAR",51,0) I $D(ARMSG("DIERR")) D "RTN","SDECAR",52,0) . F MI=1:1:$G(ARMSG("DIERR")) S RET=RET_"-1^"_$G(ARMSG("DIERR",MI,"TEXT",1))_$C(30) "RTN","SDECAR",53,0) S RET=RET_$C(31) "RTN","SDECAR",54,0) I $D(ARMSG("DIERR")) Q "RTN","SDECAR",55,0) ;SEND HL7 TO CPRS IF RTC REQUEST "RTN","SDECAR",56,0) I $P(^SDEC(409.85,ARIEN,0),U,5)="RTC" D "RTN","SDECAR",57,0) .I ARDISP=3 D ARDISP^SDECHL7(ARIEN,"") "RTN","SDECAR",58,0) .I ARDISP=9 D ARDISP^SDECHL7(ARIEN,"") "RTN","SDECAR",59,0) .I ARDISP'=3&(ARDISP'=9) D ARDISP^SDECHL7(ARIEN,1) "RTN","SDECAR",60,0) .I $D(^TMP($J,"REJECT",ARIEN)) D "RTN","SDECAR",61,0) ..S RET="-2^"_^TMP(SDHL7IN("ORDER IEN")) "RTN","SDECAR",62,0) Q "RTN","SDECAR",63,0) ; "RTN","SDECAR",64,0) AROPEN(RET,ARAPP,ARIEN,ARDDT) ;SET Appointment Request Open/re-open "RTN","SDECAR",65,0) ;AROPEN(RET,ARAPP,ARIEN,ARDDT) external parameter tag in SDEC "RTN","SDECAR",66,0) ;INPUT: "RTN","SDECAR",67,0) ; ARAPP - (required if no ARIEN) Appointment ID pointer to SDEC APPOINTMENT file 409.84 "RTN","SDECAR",68,0) ; ARIEN - (required if no ARAPP) Request ID - Pointer to SDEC APPOINTMENT REQUEST file "RTN","SDECAR",69,0) ; ARDDT - (optional) Desired Date of appointment in external format "RTN","SDECAR",70,0) N SDART,SDECI,SDQ,ARFDA,ARMSG,X,Y,%DT "RTN","SDECAR",71,0) S RET="^TMP(""SDECAR"","_$J_",""AROPEN"")" "RTN","SDECAR",72,0) K @RET "RTN","SDECAR",73,0) S (SDECI,SDQ)=0 "RTN","SDECAR",74,0) S @RET@(SDECI)="T00030ERRORID^T00030ERRTEXT"_$C(30) "RTN","SDECAR",75,0) ;validate ARAPP (required if ARIEN not passed it) "RTN","SDECAR",76,0) S ARAPP=$G(ARAPP) "RTN","SDECAR",77,0) I ARAPP'="" I $D(^SDEC(409.84,ARAPP,0)) D "RTN","SDECAR",78,0) .S SDART=$$GET1^DIQ(409.84,ARAPP_",",.22,"I") "RTN","SDECAR",79,0) .I $P(SDART,";",2)'="SDEC(409.85," S SDECI=SDECI+1 S @RET@(SDECI)="-1^Not a Requested appointment."_$C(30),SDQ=1 Q "RTN","SDECAR",80,0) .I $G(ARIEN)'="",ARIEN'=$P(SDART,";",1) S SDECI=SDECI+1 S @RET@(SDECI)="-1^Appointment Request does not match item passed in."_$C(30),SDQ=1 Q "RTN","SDECAR",81,0) .S ARIEN=$P(SDART,";",1) "RTN","SDECAR",82,0) G:SDQ ARX "RTN","SDECAR",83,0) ;validate ARIEN "RTN","SDECAR",84,0) S ARIEN=$G(ARIEN) "RTN","SDECAR",85,0) I ARIEN="" S SDECI=SDECI+1 S @RET@(SDECI)="-1^Appointment Request ID or Appointment ID is required."_$C(30,31) Q "RTN","SDECAR",86,0) I '$D(^SDEC(409.85,ARIEN,0)) S SDECI=SDECI+1 S @RET@(SDECI)="-1^Invalid Appt Request ID."_$C(30,31) Q "RTN","SDECAR",87,0) ;validate ARDDT "RTN","SDECAR",88,0) S ARDDT=$P($G(ARDDT),"@",1) "RTN","SDECAR",89,0) I $G(ARDDT)'="" S %DT="" S X=ARDDT D ^%DT I Y=-1 S SDECI=SDECI+1 S @RET@(SDECI)="-1^Invalid desired date of appointment."_$C(30,31) Q "RTN","SDECAR",90,0) S ARFDA=$NA(ARFDA(409.85,ARIEN_",")) "RTN","SDECAR",91,0) S @ARFDA@(19)="" "RTN","SDECAR",92,0) S @ARFDA@(20)="" "RTN","SDECAR",93,0) S @ARFDA@(21)="" "RTN","SDECAR",94,0) S:ARDDT'="" @ARFDA@(22)=ARDDT "RTN","SDECAR",95,0) ; Only re-open Appt Request for approved Cancellation Reasons VSE-1112 "RTN","SDECAR",96,0) N SDCANRSN "RTN","SDECAR",97,0) S SDCANRSN=$$GET1^DIQ(409.84,ARAPP_",",.122,"I") "RTN","SDECAR",98,0) I "^3^9^10^12^"'[(U_SDCANRSN_U) S @ARFDA@(23)="OPEN" "RTN","SDECAR",99,0) D UPDATE^DIE("E","ARFDA","ARRET","ARMSG") "RTN","SDECAR",100,0) I $D(ARMSG("DIERR")) D "RTN","SDECAR",101,0) . F MI=1:1:$G(ARMSG("DIERR")) S SDECI=SDECI+1 S @RET@(SDECI)="-1^"_$G(ARMSG("DIERR",MI,"TEXT",1))_$C(30) "RTN","SDECAR",102,0) I '$D(ARMSG("DIERR")) S SDECI=SDECI+1 S @RET@(SDECI)="0^"_ARIEN_$C(30) "RTN","SDECAR",103,0) ARX S @RET@(SDECI)=@RET@(SDECI)_$C(31) "RTN","SDECAR",104,0) Q "RTN","SDECAR",105,0) ; "RTN","SDECAR",106,0) FNUM(RET) ;file number "RTN","SDECAR",107,0) S RET=409.85 "RTN","SDECAR",108,0) Q RET "RTN","SDECAR",109,0) ; "RTN","SDECAR",110,0) ARPCSET(SDECY,INP,ARIEN) ;SET update patient contacts in SDEC APPT REQUEST file "RTN","SDECAR",111,0) ;ARSETPC(SDECY,INP,ARIEN) external parameter tag in SDEC "RTN","SDECAR",112,0) ; INP = Patient Contacts separated by :: "RTN","SDECAR",113,0) ; Each :: piece has the following ~~ pieces: (same as theyare passed into SDEC ARLSET) "RTN","SDECAR",114,0) ; 1) = (required) DATE ENTERED external date/time "RTN","SDECAR",115,0) ; 2) = (optional) PC ENTERED BY USER ID or NAME - Pointer to NEW PERSON file or NAME "RTN","SDECAR",116,0) ; 4) = (optional) ACTION - valid values are: "RTN","SDECAR",117,0) ; CALLED MESSAGE LEFT LETTER "RTN","SDECAR",118,0) ; 5) = (optional) PATIENT PHONE Free-Text 4-20 characters "RTN","SDECAR",119,0) ; 6) = NOT USED (optional) Comment 1-160 characters "RTN","SDECAR",120,0) ; ARIEN = (required) pointer to SDEC APPT REQUEST file 409.85 "RTN","SDECAR",121,0) N SDECI,SDTMP,ARMSG1 "RTN","SDECAR",122,0) S SDECY="^TMP(""SDECAR"","_$J_",""ARSETPC"")" "RTN","SDECAR",123,0) K @SDECY "RTN","SDECAR",124,0) S SDECI=0 "RTN","SDECAR",125,0) S @SDECY@(SDECI)="T00030RETURNCODE^T00030TEXT"_$C(30) "RTN","SDECAR",126,0) S ARIEN=$G(ARIEN) "RTN","SDECAR",127,0) I (ARIEN="")!('$D(^SDEC(409.85,ARIEN,0))) D ERR1^SDECERR(-1,"Invalid wait list ID "_ARIEN_".",SDECI,SDECY) Q "RTN","SDECAR",128,0) D AR23^SDECAR2(INP,ARIEN) "RTN","SDECAR",129,0) I $D(ARMSG1) D ERR1^SDECERR(-1,"Error storing patient contacts.",SDECI,SDECY) Q "RTN","SDECAR",130,0) S SDECI=SDECI+1 S @SDECY@(SDECI)="0^SUCCESS"_$C(30,31) "RTN","SDECAR",131,0) Q "RTN","SDECAR",132,0) ; "RTN","SDECAR",133,0) ARDGET(SDECY) ;get values for disposition field of SDEC APPT REQUEST file "RTN","SDECAR",134,0) ;ARDGET(SDECY) external parameter tag is in SDEC "RTN","SDECAR",135,0) ;INPUT: none "RTN","SDECAR",136,0) ;RETURN: "RTN","SDECAR",137,0) ; Successful Return: "RTN","SDECAR",138,0) ; Global array containing a list of the valid DISPOSITION values in which "RTN","SDECAR",139,0) ; each array entry contains the disposition text. "RTN","SDECAR",140,0) ; Caught Exception Return: "RTN","SDECAR",141,0) ; A single entry in the Global Array in the format "-1^" "RTN","SDECAR",142,0) ; "T00020RETURNCODE^T00100TEXT" "RTN","SDECAR",143,0) ; Unexpected Exception Return: "RTN","SDECAR",144,0) ; Handled by the RPC Broker. "RTN","SDECAR",145,0) ; M errors are trapped by the use of M and Kernel error handling. "RTN","SDECAR",146,0) ; The RPC execution stops and the RPC Broker sends the error generated "RTN","SDECAR",147,0) ; text back to the client. "RTN","SDECAR",148,0) N SDI,SDX,SDXI,SDECI,DIERR,SDMSG "RTN","SDECAR",149,0) S SDECI=0 "RTN","SDECAR",150,0) K ^TMP("SDEC",$J) "RTN","SDECAR",151,0) S SDECY="^TMP(""SDEC"","_$J_")" "RTN","SDECAR",152,0) ; data header "RTN","SDECAR",153,0) S @SDECY@(SDECI)="T00030TEXT"_$C(30) "RTN","SDECAR",154,0) S SDX=$$GET1^DID(409.85,21,"","POINTER","","MSG") "RTN","SDECAR",155,0) F SDI=1:1:$L(SDX,";") D "RTN","SDECAR",156,0) .S SDXI=$P(SDX,";",SDI) "RTN","SDECAR",157,0) .Q:SDXI="" "RTN","SDECAR",158,0) .S SDECI=SDECI+1 S @SDECY@(SDECI)=$P(SDXI,":",2)_$C(30) "RTN","SDECAR",159,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDECAR",160,0) Q "RTN","SDECAR",161,0) ; "RTN","SDECAR",162,0) ARMRTGET(SDECY,ARIEN) ;GET number of entries and values in MRTC CALC PREF DATES "RTN","SDECAR",163,0) ;ARMRTGET(SDECY,ARIEN) "RTN","SDECAR",164,0) ;INPUT: "RTN","SDECAR",165,0) ; ARIEN - (required) pointer to SDEC APPT REQUEST file "RTN","SDECAR",166,0) ;RETURN: "RTN","SDECAR",167,0) ; 1st entry contains a count of the number of dates in MRTC CALC PREF DATES "RTN","SDECAR",168,0) ; 2-n entry contains each date "RTN","SDECAR",169,0) N ARDATA,SDC,SDECI,SDI "RTN","SDECAR",170,0) S SDC=0 "RTN","SDECAR",171,0) S SDECI=1 ;save position 1 for count in SDC "RTN","SDECAR",172,0) S SDECY="^TMP(""SDECAR"","_$J_",""ARMRTGET"")" "RTN","SDECAR",173,0) K @SDECY "RTN","SDECAR",174,0) ; data header "RTN","SDECAR",175,0) S @SDECY@(0)="T00030ERRORCODE^T00030MESSAGE"_$C(30) "RTN","SDECAR",176,0) S ARIEN=$G(ARIEN) "RTN","SDECAR",177,0) I ARIEN="" S @SDECY@(1)="-1^SDEC APPT REQUEST id is required." Q "RTN","SDECAR",178,0) I '$D(^SDEC(409.85,+ARIEN,0)) S @SDECY@(1)="-1^Invalid SDEC APPT REQUEST id." Q "RTN","SDECAR",179,0) D GETS^DIQ(409.85,+ARIEN,"43.5*","E","ARDATA") "RTN","SDECAR",180,0) S SDI=0 F S SDI=$O(ARDATA(409.851,SDI)) Q:SDI="" D "RTN","SDECAR",181,0) .S SDC=SDC+1 "RTN","SDECAR",182,0) .S SDECI=SDECI+1 S @SDECY@(SDECI)=ARDATA(409.851,SDI,.01,"E")_$C(30) "RTN","SDECAR",183,0) S @SDECY@(1)=SDC_$C(30) "RTN","SDECAR",184,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDECAR",185,0) Q "RTN","SDECAR",186,0) ; "RTN","SDECAR",187,0) ARMULT(SDECY,ARIEN,MULT) ;SET MULT APPTS MADE multiple in SDEC APPT REQUEST file. All entries are removed and replaced by the values in MULT "RTN","SDECAR",188,0) ;INPUT: "RTN","SDECAR",189,0) ; ARIEN - (required) pointer to SDEC APPT REQUEST file (usualy a parent request) "RTN","SDECAR",190,0) ; MULT - (optional) list of child pointers to SDEC APPOINTMENT and/or "RTN","SDECAR",191,0) ; SDEC APPT REQUEST files separated by pipe "RTN","SDECAR",192,0) ; each pipe piece contains the following ~ pieces: "RTN","SDECAR",193,0) ; 1. (optional) Appointment Id pointer to SDEC APPOINTMENT "RTN","SDECAR",194,0) ; file 409.84 "RTN","SDECAR",195,0) ; 2. (optional) Request Id pointer to SDEC APPT REQUEST "RTN","SDECAR",196,0) ; file 409.85 "RTN","SDECAR",197,0) ;RETURN: "RTN","SDECAR",198,0) ; ERRORCODE^MESSAGE "RTN","SDECAR",199,0) ; "RTN","SDECAR",200,0) N MULT1,SDI "RTN","SDECAR",201,0) S SDECY="^TMP(""SDECAR"","_$J_",""ARMRTSET"")" "RTN","SDECAR",202,0) K @SDECY "RTN","SDECAR",203,0) ; data header "RTN","SDECAR",204,0) S @SDECY@(0)="T00030ERRORCODE^T00030MESSAGE"_$C(30) "RTN","SDECAR",205,0) S ARIEN=$G(ARIEN) "RTN","SDECAR",206,0) I ARIEN="" S @SDECY@(1)="-1^SDEC APPT REQUEST id is required." Q "RTN","SDECAR",207,0) I '$D(^SDEC(409.85,+ARIEN,0)) S @SDECY@(1)="-1^Invalid SDEC APPT REQUEST id." Q "RTN","SDECAR",208,0) S MULT=$G(MULT) "RTN","SDECAR",209,0) D MT1(ARIEN) "RTN","SDECAR",210,0) I MULT="" S @SDECY@(0)=@SDECY@(0)_$C(31) Q ;nothing to do "RTN","SDECAR",211,0) F SDI=1:1:$L(MULT,"|") D "RTN","SDECAR",212,0) .S MULT1=$TR($P(MULT,"|",SDI),"^","~") "RTN","SDECAR",213,0) .D AR433^SDECAR2(ARIEN,MULT1) "RTN","SDECAR",214,0) S @SDECY@(1)="0^SUCCESS"_$C(30,31) "RTN","SDECAR",215,0) Q "RTN","SDECAR",216,0) ARMRTSET(SDECY,ARIEN,MRTC) ;SET MRTC CALC PREF DATES dates - clears the multiple and sets the new ones that are passed into MRTC "RTN","SDECAR",217,0) ;ARMRTSET(SDECY,ARIEN,MRTC) "RTN","SDECAR",218,0) ;INPUT: "RTN","SDECAR",219,0) ; ARIEN - (required) pointer to SDEC APPT REQUEST file "RTN","SDECAR",220,0) ; MRTC - (optional) MRTC calculated preferred dates separated by pipe|: "RTN","SDECAR",221,0) ; Each date can be in external format with no time. "RTN","SDECAR",222,0) ;RETURN: "RTN","SDECAR",223,0) ; ERRORCODE^MESSAGE "RTN","SDECAR",224,0) N SDI,MRTC1 "RTN","SDECAR",225,0) S SDECY="^TMP(""SDECAR"","_$J_",""ARMRTSET"")" "RTN","SDECAR",226,0) K @SDECY "RTN","SDECAR",227,0) ; data header "RTN","SDECAR",228,0) S @SDECY@(0)="T00030ERRORCODE^T00030MESSAGE"_$C(30) "RTN","SDECAR",229,0) S ARIEN=$G(ARIEN) "RTN","SDECAR",230,0) I ARIEN="" S @SDECY@(1)="-1^SDEC APPT REQUEST id is required." Q "RTN","SDECAR",231,0) I '$D(^SDEC(409.85,+ARIEN,0)) S @SDECY@(1)="-1^Invalid SDEC APPT REQUEST id." Q "RTN","SDECAR",232,0) S MRTC=$G(MRTC) "RTN","SDECAR",233,0) I MRTC="" S @SDECY@(1)="0"_$C(30,31) Q ;not an error, just nothing to do "RTN","SDECAR",234,0) D MT(ARIEN) "RTN","SDECAR",235,0) D AR435^SDECAR2(MRTC,ARIEN) "RTN","SDECAR",236,0) S @SDECY@(1)="0"_$C(30,31) "RTN","SDECAR",237,0) Q "RTN","SDECAR",238,0) MT(ARIEN) ; clear out existing MRTC CALC PREF DATES "RTN","SDECAR",239,0) N DA,DIK,SDI "RTN","SDECAR",240,0) S SDI=0 F S SDI=$O(^SDEC(409.85,ARIEN,5,SDI)) Q:SDI'>0 D "RTN","SDECAR",241,0) .S DIK="^SDEC(409.85,"_ARIEN_",5," "RTN","SDECAR",242,0) .S DA=SDI "RTN","SDECAR",243,0) .S DA(1)=ARIEN "RTN","SDECAR",244,0) .D ^DIK "RTN","SDECAR",245,0) Q "RTN","SDECAR",246,0) MT1(ARIEN) ; clear out existing MULT APPTS MADE "RTN","SDECAR",247,0) N DA,DIK,SDI "RTN","SDECAR",248,0) S SDI=0 F S SDI=$O(^SDEC(409.85,ARIEN,2,SDI)) Q:SDI'>0 D "RTN","SDECAR",249,0) .S DIK="^SDEC(409.85,"_ARIEN_",2," "RTN","SDECAR",250,0) .S DA=SDI "RTN","SDECAR",251,0) .S DA(1)=ARIEN "RTN","SDECAR",252,0) .D ^DIK "RTN","SDECAR",253,0) Q "RTN","SDECAR",254,0) ; "RTN","SDECAR",255,0) ARMRTC(RET,ARIEN) ;GET the number of MRTC appointments made for this request "RTN","SDECAR",256,0) ;INPUT: "RTN","SDECAR",257,0) ; ARIEN - (required) pointer to SDEC APPT REQUEST file 409.85 "RTN","SDECAR",258,0) ;RETURN "RTN","SDECAR",259,0) ; Global array with 1 entry containing the count of appointments made under the COUNT header "RTN","SDECAR",260,0) N SDC,SDECI,SDI "RTN","SDECAR",261,0) S RET="^TMP(""SDECAR1"","_$J_",""ARMRTC"")" "RTN","SDECAR",262,0) K @RET "RTN","SDECAR",263,0) S (SDC,SDECI)=0 "RTN","SDECAR",264,0) S ARIEN=$G(ARIEN) "RTN","SDECAR",265,0) I '$D(^SDEC(409.85,ARIEN,0)) S @RET@(1)="-1^Invalid ID"_$C(30,31) Q "RTN","SDECAR",266,0) S @RET@(SDECI)="T00030COUNT"_$C(30) "RTN","SDECAR",267,0) S @RET@(1)=$$MRTC(ARIEN)_$C(30,31) "RTN","SDECAR",268,0) Q "RTN","SDECAR",269,0) MRTC(ARIEN) ; "RTN","SDECAR",270,0) N SDC,SDI "RTN","SDECAR",271,0) S SDC=0 "RTN","SDECAR",272,0) S SDI=0 F S SDI=$O(^SDEC(409.85,ARIEN,2,SDI)) Q:SDI'>0 D "RTN","SDECAR",273,0) .S SDC=SDC+1 "RTN","SDECAR",274,0) Q SDC "RTN","SDECAR",275,0) ; "RTN","SDECAR",276,0) ARAPPT(SDECY,SDAPPT) ;GET appointment request for given SDEC APPOINTMENT id "RTN","SDECAR",277,0) ;INPUT: "RTN","SDECAR",278,0) ; SDAPPT - (required) pointer to SDEC APPOINTMENT file 409.84 "RTN","SDECAR",279,0) ;RETURN "RTN","SDECAR",280,0) ; Global array with 1 entry containing the REQUEST TYPE and IEN of the associated appointment separated by pipe |: "RTN","SDECAR",281,0) ; 1. Request Type - A APPT "RTN","SDECAR",282,0) ; C Consult "RTN","SDECAR",283,0) ; E EWL "RTN","SDECAR",284,0) ; R Recall "RTN","SDECAR",285,0) ; 2. IEN - pointer to either the SDEC APPT REQUEST, REQUEST/CONSULTATION, SD WAIT LIST, or RECALL REMINDERS file "RTN","SDECAR",286,0) ; "RTN","SDECAR",287,0) N SDECI,SDTYP,SDX,SDY "RTN","SDECAR",288,0) S SDECY="^TMP(""SDECAR"","_$J_",""ARAPPT"")" "RTN","SDECAR",289,0) K @SDECY "RTN","SDECAR",290,0) S SDECI=0 "RTN","SDECAR",291,0) S @SDECY@(SDECI)="T00030SDAPTYP"_$C(30) "RTN","SDECAR",292,0) S SDAPPT=$G(SDAPPT) "RTN","SDECAR",293,0) I SDAPPT="" S @SDECY@(1)="-1^SDEC APPOINTMENT id is required."_$C(30,31) Q "RTN","SDECAR",294,0) I '$D(^SDEC(409.84,+SDAPPT,0)) S @SDECY@(1)="-1^Invalid SDEC APPOINTMENT ID."_$C(30,31) Q "RTN","SDECAR",295,0) S SDX=$$GET1^DIQ(409.84,SDAPPT_",",.22,"I") "RTN","SDECAR",296,0) S SDY=$P(SDX,";",2) "RTN","SDECAR",297,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","SDECAR",298,0) S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTYP_$C(30,31) "RTN","SDECAR",299,0) Q "RTN","SDECAR",300,0) ; "RTN","SDECAR",301,0) AUDITGET(SDECY,ARIEN) ;GET entries from VS AUDIT field of SDEC APPT REQUEST file 409.85 "RTN","SDECAR",302,0) N ARDATA,SDECI,SDI,SDTMP,SDX "RTN","SDECAR",303,0) S SDECY="^TMP(""SDECAR"","_$J_",""AUDITGET"")" "RTN","SDECAR",304,0) K @SDECY "RTN","SDECAR",305,0) S SDECI=0 "RTN","SDECAR",306,0) S SDTMP="T00030IEN^T00030ID^T00030DATE^T00030USERIEN^T00030USERNAME" "RTN","SDECAR",307,0) S SDTMP=SDTMP_"^T00030CLINIEN^T00030CLINNAME^T00030STOPIEN^T00030STOPNAME" "RTN","SDECAR",308,0) S @SDECY@(SDECI)=SDTMP_$C(30) "RTN","SDECAR",309,0) ;validate ARIEN "RTN","SDECAR",310,0) S ARIEN=$G(ARIEN) "RTN","SDECAR",311,0) I '+$D(^SDEC(409.85,+ARIEN,0)) S @SDECY@(1)="-1^Invalid SDEC APPT REQUEST id."_$C(30,31) Q "RTN","SDECAR",312,0) S SDI=0 F S SDI=$O(^SDEC(409.85,+ARIEN,6,SDI)) Q:SDI'>0 D "RTN","SDECAR",313,0) .K ARDATA "RTN","SDECAR",314,0) .D GETS^DIQ(409.8545,SDI_","_ARIEN_",","**","IE","ARDATA") "RTN","SDECAR",315,0) .S SDX="ARDATA(409.8545,"""_SDI_","_ARIEN_","")" "RTN","SDECAR",316,0) .S SDTMP=ARIEN_U_SDI_U_@SDX@(.01,"E")_U_@SDX@(1,"I")_U_@SDX@(1,"E") "RTN","SDECAR",317,0) .S SDTMP=SDTMP_U_@SDX@(2,"I")_U_@SDX@(2,"E")_U_@SDX@(3,"I")_U_@SDX@(3,"E") "RTN","SDECAR",318,0) .S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30) "RTN","SDECAR",319,0) S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31) "RTN","SDECAR",320,0) Q "RTN","SDECPRVSRCHJSON") 0^7^B7828205^n/a "RTN","SDECPRVSRCHJSON",1,0) SDECPRVSRCHJSON ;ALB/ANU - Get Providers based on Search String ;SEP 09, 2021@14:39 "RTN","SDECPRVSRCHJSON",2,0) ;;5.3;Scheduling;**797**;Aug 13, 1993;Build 8 "RTN","SDECPRVSRCHJSON",3,0) ;;Per VHA Directive 6402, this routine should not be modified "RTN","SDECPRVSRCHJSON",4,0) ; "RTN","SDECPRVSRCHJSON",5,0) ; Documented API's and Integration Agreements "RTN","SDECPRVSRCHJSON",6,0) ; ------------------------------------------- "RTN","SDECPRVSRCHJSON",7,0) ;Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056 "RTN","SDECPRVSRCHJSON",8,0) Q "RTN","SDECPRVSRCHJSON",9,0) ; "RTN","SDECPRVSRCHJSON",10,0) JSONPRVLIST(SDPRVJSON,SDSRCHSTR) ;Search PROVIDERS and get data needed to make VIDEO VISIT SERVICE (VVS) Appointment "RTN","SDECPRVSRCHJSON",11,0) ;INPUT - SDSRCHSTR (Search String) "RTN","SDECPRVSRCHJSON",12,0) ;RETURN PARMETER: "RTN","SDECPRVSRCHJSON",13,0) ; List of Providers from NEW PERSON (#200) File. Data is delimited by carat (^). "RTN","SDECPRVSRCHJSON",14,0) ; Field List: "RTN","SDECPRVSRCHJSON",15,0) ; (1) Provider Name "RTN","SDECPRVSRCHJSON",16,0) ; (2) Provider IEN "RTN","SDECPRVSRCHJSON",17,0) ; (3) Primary Phone "RTN","SDECPRVSRCHJSON",18,0) ; (4) Email Address "RTN","SDECPRVSRCHJSON",19,0) ; "RTN","SDECPRVSRCHJSON",20,0) N PROVIDERNAME,STRINGLENGTH,SDPRVSREC,ERRPOP,ERR,ERRMSG,SDECI "RTN","SDECPRVSRCHJSON",21,0) D INIT "RTN","SDECPRVSRCHJSON",22,0) D VALIDATE "RTN","SDECPRVSRCHJSON",23,0) I ERRPOP D BLDJSON Q "RTN","SDECPRVSRCHJSON",24,0) D BLDPRVREC "RTN","SDECPRVSRCHJSON",25,0) D BLDJSON "RTN","SDECPRVSRCHJSON",26,0) Q "RTN","SDECPRVSRCHJSON",27,0) ; "RTN","SDECPRVSRCHJSON",28,0) INIT ; initialize values needed "RTN","SDECPRVSRCHJSON",29,0) S SDECI=0 "RTN","SDECPRVSRCHJSON",30,0) S SDECI=$G(SDECI,0),ERR="" "RTN","SDECPRVSRCHJSON",31,0) S STRINGLENGTH=$L(SDSRCHSTR) "RTN","SDECPRVSRCHJSON",32,0) S PROVIDERNAME=$O(^VA(200,"B",SDSRCHSTR),-1) "RTN","SDECPRVSRCHJSON",33,0) I $E(PROVIDERNAME,1,SDSRCHSTR)=SDSRCHSTR D "RTN","SDECPRVSRCHJSON",34,0) .S PROVIDERNAME=$O(^VA(200,"B",PROVIDERNAME),-1) "RTN","SDECPRVSRCHJSON",35,0) S ERRPOP=0,SDECI=0,ERRMSG="" "RTN","SDECPRVSRCHJSON",36,0) Q "RTN","SDECPRVSRCHJSON",37,0) ; "RTN","SDECPRVSRCHJSON",38,0) VALIDATE ; validate incoming parameters "RTN","SDECPRVSRCHJSON",39,0) I $L(SDSRCHSTR)<2 D "RTN","SDECPRVSRCHJSON",40,0) . ;create error message - Search String must be at least 2 characters "RTN","SDECPRVSRCHJSON",41,0) . D ERRLOG^SDESJSON(.SDPRVSREC,64) "RTN","SDECPRVSRCHJSON",42,0) . S ERRPOP=1 "RTN","SDECPRVSRCHJSON",43,0) Q "RTN","SDECPRVSRCHJSON",44,0) ; "RTN","SDECPRVSRCHJSON",45,0) BLDJSON ; "RTN","SDECPRVSRCHJSON",46,0) D ENCODE^SDESJSON(.SDPRVSREC,.SDPRVJSON,.ERR) "RTN","SDECPRVSRCHJSON",47,0) K SDPRVSREC "RTN","SDECPRVSRCHJSON",48,0) Q "RTN","SDECPRVSRCHJSON",49,0) ; "RTN","SDECPRVSRCHJSON",50,0) BLDPRVREC ;Build a list of Providers "RTN","SDECPRVSRCHJSON",51,0) ; "RTN","SDECPRVSRCHJSON",52,0) N VVSPROVIDER,PROVIDERIEN "RTN","SDECPRVSRCHJSON",53,0) F S PROVIDERNAME=$O(^VA(200,"B",PROVIDERNAME)) Q:PROVIDERNAME=""!($E(PROVIDERNAME,1,STRINGLENGTH)'=SDSRCHSTR) D "RTN","SDECPRVSRCHJSON",54,0) .I SDECI>49 Q "RTN","SDECPRVSRCHJSON",55,0) .S (VVSPROVIDER,PROVIDERIEN)="" "RTN","SDECPRVSRCHJSON",56,0) .S PROVIDERIEN=$O(^VA(200,"B",PROVIDERNAME,PROVIDERIEN)) Q:PROVIDERIEN="" D "RTN","SDECPRVSRCHJSON",57,0) ..I $$GET1^DIQ(200,PROVIDERIEN,7,"I")'=1 D "RTN","SDECPRVSRCHJSON",58,0) ...D GETPROINFO^SDECVVS(.VVSPROVIDER,PROVIDERIEN) "RTN","SDECPRVSRCHJSON",59,0) ...I VVSPROVIDER'="" D "RTN","SDECPRVSRCHJSON",60,0) ....S SDECI=SDECI+1 "RTN","SDECPRVSRCHJSON",61,0) ....S SDPRVSREC("Provider",SDECI,"IEN")=$P(VVSPROVIDER,"^",1) "RTN","SDECPRVSRCHJSON",62,0) ....S SDPRVSREC("Provider",SDECI,"Name")=$P(VVSPROVIDER,"^",2) "RTN","SDECPRVSRCHJSON",63,0) ....S SDPRVSREC("Provider",SDECI,"Email")=$P(VVSPROVIDER,"^",3) "RTN","SDECPRVSRCHJSON",64,0) ....S SDPRVSREC("Provider",SDECI,"Cell")=$P(VVSPROVIDER,"^",4) "RTN","SDECPRVSRCHJSON",65,0) I '$D(SDPRVSREC("Provider")) S SDPRVSREC("Provider")="" "RTN","SDECPRVSRCHJSON",66,0) I SDECI=0 D "RTN","SDECPRVSRCHJSON",67,0) . ;create error message - No Providers found that match Search String "RTN","SDECPRVSRCHJSON",68,0) . D ERRLOG^SDESJSON(.SDPRVSREC,65) "RTN","SDECPRVSRCHJSON",69,0) . S ERRPOP=1 "RTN","SDECPRVSRCHJSON",70,0) Q "RTN","SDECPRVSRCHJSON",71,0) ; "RTN","SDECVVSJSON") 0^6^B14869168^n/a "RTN","SDECVVSJSON",1,0) SDECVVSJSON ;ALB/ANU - Get Patient, Provider and System Info to make VVS call ;SEP 09, 2021@14:39 "RTN","SDECVVSJSON",2,0) ;;5.3;Scheduling;**797**;Aug 13, 1993;Build 8 "RTN","SDECVVSJSON",3,0) ;;Per VHA Directive 6402, this routine should not be modified "RTN","SDECVVSJSON",4,0) ; "RTN","SDECVVSJSON",5,0) ; Documented API's and Integration Agreements "RTN","SDECVVSJSON",6,0) ; ------------------------------------------- "RTN","SDECVVSJSON",7,0) ;Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056 "RTN","SDECVVSJSON",8,0) Q "RTN","SDECVVSJSON",9,0) ; "RTN","SDECVVSJSON",10,0) GETVVSMAKEINFO(SDVVSJSON,PATIENTIEN,CLINICIEN) ;GET INFO TO MAKE A VIDEO VISIT WEB SERVICE (VVS) CALL "RTN","SDECVVSJSON",11,0) ;INPUT - PATIENTIEN (Patient IEN) "RTN","SDECVVSJSON",12,0) ;INPUT - CLINICIEN (Clinic IEN) "RTN","SDECVVSJSON",13,0) ;RETURN PARMETER: "RTN","SDECVVSJSON",14,0) ; Field List: "RTN","SDECVVSJSON",15,0) ; (1) Patient Info "RTN","SDECVVSJSON",16,0) ; (2) Default Provider Info "RTN","SDECVVSJSON",17,0) ; (3) System Info "RTN","SDECVVSJSON",18,0) ; "RTN","SDECVVSJSON",19,0) N SDVVSREC,ERRPOP,ERR,ERRMSG,SDESI,VVSPATIENT,VVSPROVIDER,PROVIDERINFO,VVSSYSTEMINFO "RTN","SDECVVSJSON",20,0) D INIT "RTN","SDECVVSJSON",21,0) D VALIDATE "RTN","SDECVVSJSON",22,0) I ERRPOP D BLDJSON Q "RTN","SDECVVSJSON",23,0) D BLDVVSREC "RTN","SDECVVSJSON",24,0) D BLDJSON "RTN","SDECVVSJSON",25,0) ; "RTN","SDECVVSJSON",26,0) K PATINFO,PROVIDERIEN,PROVIDERINFO,VVSSYSTEMINFO "RTN","SDECVVSJSON",27,0) Q "RTN","SDECVVSJSON",28,0) ; "RTN","SDECVVSJSON",29,0) INIT ; initialize values needed "RTN","SDECVVSJSON",30,0) S SDESI=0 "RTN","SDECVVSJSON",31,0) S SDESI=$G(SDESI,0),ERR="" "RTN","SDECVVSJSON",32,0) S (VVSPATIENT,VVSPROVIDER,PROVIDERINFO,VVSSYSTEMINFO)="" "RTN","SDECVVSJSON",33,0) S ERRPOP=0,SDESI=0,ERRMSG="" "RTN","SDECVVSJSON",34,0) Q "RTN","SDECVVSJSON",35,0) ; "RTN","SDECVVSJSON",36,0) VALIDATE ; validate incoming parameters "RTN","SDECVVSJSON",37,0) I PATIENTIEN="" D "RTN","SDECVVSJSON",38,0) . ;create error message - Patient IEN cannot be blank "RTN","SDECVVSJSON",39,0) . D ERRLOG^SDESJSON(.SDVVSREC,66) "RTN","SDECVVSJSON",40,0) . S ERRPOP=1 "RTN","SDECVVSJSON",41,0) I CLINICIEN="" D "RTN","SDECVVSJSON",42,0) . ;create error message - Clinic IEN cannot be blank "RTN","SDECVVSJSON",43,0) . D ERRLOG^SDESJSON(.SDVVSREC,67) "RTN","SDECVVSJSON",44,0) . S ERRPOP=1 "RTN","SDECVVSJSON",45,0) Q "RTN","SDECVVSJSON",46,0) ; "RTN","SDECVVSJSON",47,0) BLDJSON ; "RTN","SDECVVSJSON",48,0) D ENCODE^SDESJSON(.SDVVSREC,.SDVVSJSON,.ERR) "RTN","SDECVVSJSON",49,0) K SDVVSREC "RTN","SDECVVSJSON",50,0) Q "RTN","SDECVVSJSON",51,0) ; "RTN","SDECVVSJSON",52,0) BLDVVSREC ;Build VVS info "RTN","SDECVVSJSON",53,0) ; "RTN","SDECVVSJSON",54,0) S VVSPATIENT="" "RTN","SDECVVSJSON",55,0) D GETVVSPATIENT^SDECVVS(.VVSPATIENT,PATIENTIEN) "RTN","SDECVVSJSON",56,0) I VVSPATIENT'="" D "RTN","SDECVVSJSON",57,0) .S SDESI=1 "RTN","SDECVVSJSON",58,0) .S SDVVSREC("VVSMakeInfo","Patient","IEN")=$P(VVSPATIENT,"^",1) "RTN","SDECVVSJSON",59,0) .S SDVVSREC("VVSMakeInfo","Patient","DateOfBirth")=$P(VVSPATIENT,"^",2) "RTN","SDECVVSJSON",60,0) .S SDVVSREC("VVSMakeInfo","Patient","FirstName")=$P(VVSPATIENT,"^",3) "RTN","SDECVVSJSON",61,0) .S SDVVSREC("VVSMakeInfo","Patient","LastName")=$P(VVSPATIENT,"^",4) "RTN","SDECVVSJSON",62,0) .S SDVVSREC("VVSMakeInfo","Patient","SSN")=$P(VVSPATIENT,"^",5) "RTN","SDECVVSJSON",63,0) .S SDVVSREC("VVSMakeInfo","Patient","Email")=$P(VVSPATIENT,"^",6) "RTN","SDECVVSJSON",64,0) .S SDVVSREC("VVSMakeInfo","Patient","HomePhone")=$P(VVSPATIENT,"^",7) "RTN","SDECVVSJSON",65,0) .S SDVVSREC("VVSMakeInfo","Patient","CellPhone")=$P(VVSPATIENT,"^",8) "RTN","SDECVVSJSON",66,0) .S SDVVSREC("VVSMakeInfo","Patient","ICN")=$P(VVSPATIENT,"^",9) "RTN","SDECVVSJSON",67,0) .S SDVVSREC("VVSMakeInfo","Patient","ZipCode")=$P(VVSPATIENT,"^",10) "RTN","SDECVVSJSON",68,0) D GETDPROIEN^SDECVVS(.PROVIDERIEN,CLINICIEN) "RTN","SDECVVSJSON",69,0) D GETPROINFO^SDECVVS(.PROVIDERINFO,PROVIDERIEN) "RTN","SDECVVSJSON",70,0) I PROVIDERINFO'="" D "RTN","SDECVVSJSON",71,0) .S SDESI=1 "RTN","SDECVVSJSON",72,0) .S SDVVSREC("VVSMakeInfo","Provider","IEN")=$P(PROVIDERINFO,"^",1) "RTN","SDECVVSJSON",73,0) .S SDVVSREC("VVSMakeInfo","Provider","Name")=$P(PROVIDERINFO,"^",2) "RTN","SDECVVSJSON",74,0) .S SDVVSREC("VVSMakeInfo","Provider","Email")=$P(PROVIDERINFO,"^",3) "RTN","SDECVVSJSON",75,0) .S SDVVSREC("VVSMakeInfo","Provider","Cell")=$P(PROVIDERINFO,"^",4) "RTN","SDECVVSJSON",76,0) D GETSYSTEMINFO^SDECVVS(.VVSSYSTEMINFO) "RTN","SDECVVSJSON",77,0) I VVSSYSTEMINFO'="" D "RTN","SDECVVSJSON",78,0) .S SDESI=1 "RTN","SDECVVSJSON",79,0) .S SDVVSREC("VVSMakeInfo","SystemInfo","FacilityCode")=$P(VVSSYSTEMINFO,"^",1) "RTN","SDECVVSJSON",80,0) .S SDVVSREC("VVSMakeInfo","SystemInfo","FacilityName")=$P(VVSSYSTEMINFO,"^",2) "RTN","SDECVVSJSON",81,0) .S SDVVSREC("VVSMakeInfo","SystemInfo","TimeZone")=$P(VVSSYSTEMINFO,"^",3) "RTN","SDECVVSJSON",82,0) I '$D(SDVVSREC("VVSMakeInfo")) S SDVVSREC("VVSMakeInfo")="" "RTN","SDECVVSJSON",83,0) ; "RTN","SDECVVSJSON",84,0) I SDESI=0 D "RTN","SDECVVSJSON",85,0) . ;create error message - No VVS info found "RTN","SDECVVSJSON",86,0) . D ERRLOG^SDESJSON(.SDVVSREC,68) "RTN","SDECVVSJSON",87,0) . S ERRPOP=1 "RTN","SDECVVSJSON",88,0) Q "RTN","SDECVVSJSON",89,0) ; "RTN","SDES") 0^1^B17156529^B16481556 "RTN","SDES",1,0) SDES ;ALB/MGD/LAB,TAW - VISTA SCHEDULING RPCS ;Sep 15, 2021 "RTN","SDES",2,0) ;;5.3;Scheduling;**788,790,792,794,797**;Aug 13, 1993;Build 8 "RTN","SDES",3,0) ;;Per VHA Directive 6402, this routine should not be modified "RTN","SDES",4,0) Q "RTN","SDES",5,0) ; This routine documents the entry points for the new VS GUI version 3.0. "RTN","SDES",6,0) ; "RTN","SDES",7,0) DISPOSITION(RET,ARIEN,DISP,DISPBY,DISPDT) ;RPC: SDES ARCLOSE "RTN","SDES",8,0) D DISPOSITION^SDESARCLOSE(.RET,$G(ARIEN),$G(DISP),$G(DISPBY),$G(DISPDT)) Q "RTN","SDES",9,0) ARGETIENJSON(RET,IEN) ;RPC: SDES GET PAT APPT REQ BY IEN "RTN","SDES",10,0) D ARGETIENJSON^SDESARGET(.RET,IEN) Q "RTN","SDES",11,0) ARGETPATJSON(RET,DFN) ;RPC: SDES PATIENT APPT REQ GET "RTN","SDES",12,0) D ARGETPATJSON^SDESARGET(.RET,DFN) Q "RTN","SDES",13,0) APPTBLOCKMOVE(RETURN,APPTIEN,SDRES,APPTDTTM) ; RPC: SDES MAKE APPT BLOCK AND MOVE "RTN","SDES",14,0) D APPTBLOCKMOVE^SDESBLKANDMOVE(.RETURN,$G(APPTIEN),$G(SDRES),$G(APPTDTTM)) Q "RTN","SDES",15,0) APPTBYCLINIC(JSON,CLINICIEN,SDBEG,SDEND) ;SDES GET APPT BY CLINIC "RTN","SDES",16,0) D APPTBYCLINIC^SDESAPPT(.JSON,$G(CLINICIEN),$G(SDBEG),$G(SDEND)) Q "RTN","SDES",17,0) APPTBYRESOURCE(JSON,RESIEN,SDBEG,SDEND) ;SDES GET APPT BY RESOURCE "RTN","SDES",18,0) D APPTBYRESOURCE^SDESAPPT(.JSON,$G(RESIEN),$G(SDBEG),$G(SDEND)) Q "RTN","SDES",19,0) APPGETJSON(JSON,DFN,SDBEG,SDEND) ; "RTN","SDES",20,0) D APPGETJSON^SDESAPPT(.JSON,$G(DFN),$G(SDBEG),$G(SDEND)) Q "RTN","SDES",21,0) APPGETONEJSON(JSON,APPTIEN) ; "RTN","SDES",22,0) D APPGETONEJSON^SDESAPPT(.JSON,$G(APPTIEN)) Q "RTN","SDES",23,0) ; Parameter list for APTREQCREATE and APTREQUPDATE *MUST* be kept in sync. "RTN","SDES",24,0) APTREQCREATE(JSON,ARIEN,DFN,AREDT,ARINST,ARTYPE,ARCLIN,ARUSER,ARREQBY,ARPROV,ARDAPTDT,ARCOMM,ARENPRI,ARMAR,ARMAI,AMRAN,ARPATCONT,ARSVCCON,ARSVCCOP,MRTCPREFDT,ARSTOP,ARAPTYP,ARPATSTAT,MULTIAPTMADE,ARPARENT,ARNLT,ARPRER,ARORDN,VAOSGUID) ; "RTN","SDES",25,0) S ARIEN="" ;There will never be an IEN when calling this RPC "RTN","SDES",26,0) D ARSET Q "RTN","SDES",27,0) APTREQUPDATE(JSON,ARIEN,DFN,AREDT,ARINST,ARTYPE,ARCLIN,ARUSER,ARREQBY,ARPROV,ARDAPTDT,ARCOMM,ARENPRI,ARMAR,ARMAI,AMRAN,ARPATCONT,ARSVCCON,ARSVCCOP,MRTCPREFDT,ARSTOP,ARAPTYP,ARPATSTAT,MULTIAPTMADE,ARPARENT,ARNLT,ARPRER,ARORDN,VAOSGUID) ; "RTN","SDES",28,0) S ARIEN=$G(ARIEN,"") "RTN","SDES",29,0) S:ARIEN="" ARIEN=-1 ;Flag missing ARIEN when calling the update RPC "RTN","SDES",30,0) D ARSET Q "RTN","SDES",31,0) ARSET ;Called from APTREQCREATE and APTREQUPDATE tags "RTN","SDES",32,0) S DFN=$G(DFN),AREDT=$G(AREDT),ARINST=$G(ARINST),ARTYPE=$G(ARTYPE),ARCLIN=$G(ARCLIN),ARUSER=$G(ARUSER),ARREQBY=$G(ARREQBY),ARPROV=$G(ARPROV),ARDAPTDT=$G(ARDAPTDT),ARCOMM=$G(ARCOMM),ARENPRI=$G(ARENPRI) "RTN","SDES",33,0) S ARMAR=$G(ARMAR),ARMAI=$G(ARMAI),AMRAN=$G(AMRAN),ARPATCONT=$G(ARPATCONT),ARSVCCON=$G(ARSVCCON),ARSVCCOP=$G(ARSVCCOP),MRTCPREFDT=$G(MRTCPREFDT),ARSTOP=$G(ARSTOP),ARAPTYP=$G(ARAPTYP),ARPATSTAT=$G(ARPATSTAT) "RTN","SDES",34,0) S MULTIAPTMADE=$G(MULTIAPTMADE),ARPARENT=$G(ARPARENT),ARNLT=$G(ARNLT),ARPRER=$G(ARPRER),ARORDN=$G(ARORDN),VAOSGUID=$G(VAOSGUID) "RTN","SDES",35,0) ; Because of an SAC limication on the number of chars per line, addition of more parameters will require "RTN","SDES",36,0) ; this to be changed over to passing an array. "RTN","SDES",37,0) D ARSET^SDESAPTREQSET(.JSON,ARIEN,DFN,AREDT,ARINST,ARTYPE,ARCLIN,ARUSER,ARREQBY,ARPROV,ARDAPTDT,ARCOMM,ARENPRI,ARMAR,ARMAI,AMRAN,ARPATCONT,ARSVCCON,ARSVCCOP,MRTCPREFDT,ARSTOP,ARAPTYP,ARPATSTAT,MULTIAPTMADE,ARPARENT,ARNLT,ARPRER,ARORDN,VAOSGUID) "RTN","SDES",38,0) Q "RTN","SDES",39,0) ; "RTN","SDES",40,0) CHECKIN(JSON,SDECAPTID,SDECCDT,SDECCC,SDECPRV) ;SDES APPT CHECKIN JSON "RTN","SDES",41,0) D CHECKIN^SDES25(.JSON,$G(SDECAPTID),$G(SDECCDT),$G(SDECCC),$G(SDECPRV)) Q "RTN","SDES",42,0) CLINICSEARCH(SDECY,SEARCHSTRING) ;Given a search string return a clinic list that matches. "RTN","SDES",43,0) D CLINICSEARCH^SDESSEARCH(.SDECY,SEARCHSTRING) Q "RTN","SDES",44,0) CLINICRSCSEARCH(SDECY,SEARCHSTRING) ;Given a search string return a clinic list that matches. "RTN","SDES",45,0) D CLINICRSC^SDES01C(.SDECY,SEARCHSTRING) Q "RTN","SDES",46,0) INSURVERIFYREQ(JSON,DFN) ;SDES GET INSRUANCE VERIFY REQ "RTN","SDES",47,0) D INSURVERIFYREQ^SDESPATRPC(.JSON,$G(DFN)) Q "RTN","SDES",48,0) SPACEBAR(SDECY,SDECDIC,SDECVAL) ;EP Update ^DISV with most recent lookup value SDECVAL from file SDECDIC "RTN","SDES",49,0) D SPACEBAR^SDES30(.SDECY,$G(SDECDIC),$G(SDECVAL)) Q "RTN","SDES",50,0) Q "RTN","SDESBLKANDMOVE") 0^3^B162734102^n/a "RTN","SDESBLKANDMOVE",1,0) SDESBLKANDMOVE ;ALB/MGD/TAW - APPOINTMENT CREATE AND UPDATE ;Sep 15, 2021 "RTN","SDESBLKANDMOVE",2,0) ;;5.3;Scheduling;**797**;Aug 13, 1993;Build 8 "RTN","SDESBLKANDMOVE",3,0) ;;Per VHA Directive 6402, this routine should not be modified "RTN","SDESBLKANDMOVE",4,0) ; "RTN","SDESBLKANDMOVE",5,0) APPTBLOCKMOVE(RETURN,APPTIEN,TORES,TODTNET) ; "RTN","SDESBLKANDMOVE",6,0) N POP,SDAPPT,TODTFM,FROMRES,APPTARY,FN,SDECAPPTIENS,NEWAPPTIEN,TODTFMEND,TOTIMESCALE,SDTOCLIEN "RTN","SDESBLKANDMOVE",7,0) N SDDATA44SL,FROMDTFM,FROMDTNET,TIMESCALEDIFF,FROMRES,SDSLOT2BLK,SDRIEN,FROMTIMESCALE,SDORGCLIEN,TOTSLOTSUSED "RTN","SDESBLKANDMOVE",8,0) S (POP,NEWAPPTIEN,TIMESCALEDIFF)=0,TODTFMEND="" "RTN","SDESBLKANDMOVE",9,0) D VALIDATEBAM "RTN","SDESBLKANDMOVE",10,0) I 'POP D LOADAPPTDATA,VALIDATEBAM2 "RTN","SDESBLKANDMOVE",11,0) I 'POP D COMPARETIMESCALE "RTN","SDESBLKANDMOVE",12,0) I 'POP D CHKAVAILABILITY(TORES,TODTFM,TODTNET,0) "RTN","SDESBLKANDMOVE",13,0) I 'POP D:TIMESCALEDIFF CHKAVAILABILITY(FROMRES,FROMDTFM,FROMDTNET,TIMESCALEDIFF) "RTN","SDESBLKANDMOVE",14,0) I 'POP D OVBCHECK(SDTOCLIEN,TODTFM) "RTN","SDESBLKANDMOVE",15,0) I 'POP D APPDEL "RTN","SDESBLKANDMOVE",16,0) I 'POP D APPADD(APPTIEN,TODTFM,TOTIMESCALE,TORES) "RTN","SDESBLKANDMOVE",17,0) I 'POP D PREBLOCK(FROMDTFM,FROMTIMESCALE,FROMRES,SDORGCLIEN,SDDATA44SL,TOTSLOTSUSED) "RTN","SDESBLKANDMOVE",18,0) I 'POP D "RTN","SDESBLKANDMOVE",19,0) .I NEWAPPTIEN S SDAPPT("BlockAndMove","NewAppointmentIEN")=NEWAPPTIEN "RTN","SDESBLKANDMOVE",20,0) .E D ERRLOG^SDESJSON(.SDAPPT) ;This should not happen but..force unknown error "RTN","SDESBLKANDMOVE",21,0) D BUILDER "RTN","SDESBLKANDMOVE",22,0) Q "RTN","SDESBLKANDMOVE",23,0) ; "RTN","SDESBLKANDMOVE",24,0) VALIDATEBAM ;Validdate input parameters from the APPTBLOCKMOVE entry point "RTN","SDESBLKANDMOVE",25,0) S APPTIEN=$G(APPTIEN) "RTN","SDESBLKANDMOVE",26,0) I APPTIEN="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,3) "RTN","SDESBLKANDMOVE",27,0) I APPTIEN'="",'$D(^SDEC(409.84,APPTIEN,0)) S POP=1 D ERRLOG^SDESJSON(.SDAPPT,4) "RTN","SDESBLKANDMOVE",28,0) ; "RTN","SDESBLKANDMOVE",29,0) S TORES=$G(TORES) "RTN","SDESBLKANDMOVE",30,0) I TORES="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,69) "RTN","SDESBLKANDMOVE",31,0) I TORES'="",'$D(^SDEC(409.831,TORES,0)) S POP=1 D ERRLOG^SDESJSON(.SDAPPT,70) "RTN","SDESBLKANDMOVE",32,0) ; "RTN","SDESBLKANDMOVE",33,0) S TODTNET=$G(TODTNET) "RTN","SDESBLKANDMOVE",34,0) I TODTNET="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,76) "RTN","SDESBLKANDMOVE",35,0) I TODTNET'="" D "RTN","SDESBLKANDMOVE",36,0) .S TODTFM=$$NETTOFM^SDECDATE(TODTNET) "RTN","SDESBLKANDMOVE",37,0) .I TODTFM=-1 S POP=1 D ERRLOG^SDESJSON(.SDAPPT,77) Q "RTN","SDESBLKANDMOVE",38,0) .I $P(TODTFM,".")
TOTIMESCALE S POP=1 D ERRLOG^SDESJSON(.SDAPPT,74) "RTN","SDESBLKANDMOVE",80,0) I FROMTIMESCALE0 S TIMESCALEDIFF=TIMESCALEDIFF+1 "RTN","SDESBLKANDMOVE",83,0) ; Determine # slots occupied by original appt "RTN","SDESBLKANDMOVE",84,0) I 'POP D "RTN","SDESBLKANDMOVE",85,0) .S TOTSLOTSUSED=$G(APPTARY(FN,SDECAPPTIENS,.18,"I"))/FROMTIMESCALE "RTN","SDESBLKANDMOVE",86,0) .I TOTSLOTSUSED=0 S TOTSLOTSUSED=$$SLOTSUSED() "RTN","SDESBLKANDMOVE",87,0) Q "RTN","SDESBLKANDMOVE",88,0) ; "RTN","SDESBLKANDMOVE",89,0) CHKAVAILABILITY(RES,APPTDTFM,APPTDTNET,SLOTRANGE) ;Check the Clinic Resource and Appt Dt for slot availability "RTN","SDESBLKANDMOVE",90,0) ;Assume: "RTN","SDESBLKANDMOVE",91,0) ; APPTDTFM -Appointment date/time in FM format "RTN","SDESBLKANDMOVE",92,0) ; APPTDTNET -Appointment date/time in external format "RTN","SDESBLKANDMOVE",93,0) ; RES -Clinic resource of the new appointment "RTN","SDESBLKANDMOVE",94,0) ; SLOTRANGE -Number of slots in From Clinic that need to be checked for availability. "RTN","SDESBLKANDMOVE",95,0) ; "RTN","SDESBLKANDMOVE",96,0) N RET,TEXT,I,APPTSTARTTIME,DATA,SLOTS,CNT "RTN","SDESBLKANDMOVE",97,0) S SLOTS="",CNT=0 "RTN","SDESBLKANDMOVE",98,0) S APPTSTARTTIME=$E($P(APPTDTFM,".",2)_"00",1,4) "RTN","SDESBLKANDMOVE",99,0) K ^TMP("SDEC57",$J) "RTN","SDESBLKANDMOVE",100,0) D APPSLOTS^SDEC57(.RET,RES,APPTDTNET,APPTDTNET) "RTN","SDESBLKANDMOVE",101,0) S TEXT=$G(^TMP("SDEC57",$J,"APPSLOTS",1)) "RTN","SDESBLKANDMOVE",102,0) I $P(TEXT,"^",1)=-1 D Q "RTN","SDESBLKANDMOVE",103,0) .S POP=1 D ERRLOG^SDESJSON(.SDAPPT,52,$P(TEXT,"^",2)) "RTN","SDESBLKANDMOVE",104,0) .K ^TMP("SDEC57",$J) "RTN","SDESBLKANDMOVE",105,0) ; "RTN","SDESBLKANDMOVE",106,0) S I=0 "RTN","SDESBLKANDMOVE",107,0) ;DATA = fm dt ^ fm time ^ ^# of slots "RTN","SDESBLKANDMOVE",108,0) F S I=$O(^TMP("SDEC57",$J,"APPSLOTS",I)) Q:I="" D "RTN","SDESBLKANDMOVE",109,0) .S DATA=^TMP("SDEC57",$J,"APPSLOTS",I) "RTN","SDESBLKANDMOVE",110,0) .I $P(DATA,"^",2)0 S POP=1 D ERRLOG^SDESJSON(.SDAPPT,75) "RTN","SDESBLKANDMOVE",117,0) .;Check availability to be able to BLOCK slots in the From Clinic "RTN","SDESBLKANDMOVE",118,0) .; When moving from a 20 min appt into a 30 min appt, need to block two 20 min slots "RTN","SDESBLKANDMOVE",119,0) .; in the original clinic. Both 20 min slots must be available to be BLOCKED. Otherwise "RTN","SDESBLKANDMOVE",120,0) .; the appointment can not be moved. "RTN","SDESBLKANDMOVE",121,0) .I SLOTRANGE D "RTN","SDESBLKANDMOVE",122,0) ..S CNT=CNT+1 "RTN","SDESBLKANDMOVE",123,0) ..;NOTE: Don't check Slots for the APPTSTARTIME since the original appointment is still scheduled "RTN","SDESBLKANDMOVE",124,0) ..;and thus the Slot is still occupied by that appointment. "RTN","SDESBLKANDMOVE",125,0) ..I CNT>TOTSLOTSUSED,CNT'>SLOTRANGE D "RTN","SDESBLKANDMOVE",126,0) ...S SDSLOT2BLK($P(DATA,"^",2))="" "RTN","SDESBLKANDMOVE",127,0) ...S SLOTS=$P(DATA,"^",4) "RTN","SDESBLKANDMOVE",128,0) ...;Must have at least 1 available slot for the new appointment "RTN","SDESBLKANDMOVE",129,0) ...I +SLOTS'>0 S POP=1 D ERRLOG^SDESJSON(.SDAPPT,75) "RTN","SDESBLKANDMOVE",130,0) K ^TMP("SDEC57",$J) "RTN","SDESBLKANDMOVE",131,0) Q "RTN","SDESBLKANDMOVE",132,0) ; "RTN","SDESBLKANDMOVE",133,0) SLOTSUSED() ; "RTN","SDESBLKANDMOVE",134,0) N STARTTIME,ENDTIME,TIMEDIFF,SLOTS "RTN","SDESBLKANDMOVE",135,0) S STARTTIME=$G(APPTARY(FN,SDECAPPTIENS,.01,"I")) "RTN","SDESBLKANDMOVE",136,0) I STARTTIME="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,25,"from originating clinic") "RTN","SDESBLKANDMOVE",137,0) S ENDTIME=$G(APPTARY(FN,SDECAPPTIENS,.01,"I")) "RTN","SDESBLKANDMOVE",138,0) I ENDTIME="" S POP=1 D ERRLOG^SDESJSON(.SDAPPT,26,"from originating clinic") "RTN","SDESBLKANDMOVE",139,0) Q:POP "RTN","SDESBLKANDMOVE",140,0) S TIMEDIFF=$$FMDIFF^XLFDT(ENDTIME,STARTTIME,2) "RTN","SDESBLKANDMOVE",141,0) I TIMEDIFF=0!((TIMEDIFF/60)>240) S POP=1 D ERRLOG^SDESJSON(.SDAPPT,79) Q "RTN","SDESBLKANDMOVE",142,0) S TIMEDIFF=TIMEDIFF/60 ; total mins of appt "RTN","SDESBLKANDMOVE",143,0) S SLOTS=TIMEDIFF/FROMTIMESCALE ; Number of slots the appt covers "RTN","SDESBLKANDMOVE",144,0) I SLOTS=0!($P(SLOTS,".",2)) S POP=1 D ERRLOG^SDESJSON(.SDAPPT,79) "RTN","SDESBLKANDMOVE",145,0) Q SLOTS "RTN","SDESBLKANDMOVE",146,0) ; "RTN","SDESBLKANDMOVE",147,0) OVBCHECK(SDTOCLIEN,TODTFM) ; "RTN","SDESBLKANDMOVE",148,0) N OBM,SDECWKIN "RTN","SDESBLKANDMOVE",149,0) D OVBINIT "RTN","SDESBLKANDMOVE",150,0) S OBM=$$OBM1^SDEC57(SDTOCLIEN,TODTFM,0,,+SDECWKIN) ; Passing MRTC (3rd param) in as 0:False "RTN","SDESBLKANDMOVE",151,0) I OBM'="",+OBM'=1 S POP=1 D ERRLOG^SDESJSON(.SDAPPT,52,"Overbook not allowed") "RTN","SDESBLKANDMOVE",152,0) Q "RTN","SDESBLKANDMOVE",153,0) ; "RTN","SDESBLKANDMOVE",154,0) OVBINIT ;initialize variables for OVBCHECK and APPADD "RTN","SDESBLKANDMOVE",155,0) ; "RTN","SDESBLKANDMOVE",156,0) N SDDFN,SDECATID "RTN","SDESBLKANDMOVE",157,0) S SDECWKIN="" "RTN","SDESBLKANDMOVE",158,0) S SDECATID=$G(APPTARY(FN,SDECAPPTIENS,.13,"E")) ;WALKIN - WALKIN flag y=YES; n=NO default to NO "RTN","SDESBLKANDMOVE",159,0) S SDDFN=$G(APPTARY(FN,SDECAPPTIENS,.05,"I")) ;Patient ID/DFN "RTN","SDESBLKANDMOVE",160,0) I SDECATID=""!(SDECATID="NO") S SDECATID=$P($G(^DPT(SDDFN,"S",TODTFM,0)),U,7) ;get the purpose of visit in the patient file if NULL in file 409.84 "RTN","SDESBLKANDMOVE",161,0) S SDECATID=$S(SDECATID="YES"!(SDECATID=4):"WALKIN",1:SDECATID) "RTN","SDESBLKANDMOVE",162,0) I SDECATID="WALKIN" S SDECWKIN=1 "RTN","SDESBLKANDMOVE",163,0) ;I SDECATID'?.N&(SDECATID'="WALKIN") S SDECATID="" "RTN","SDESBLKANDMOVE",164,0) ;S SDECCR=$S(SDECATID="WALKIN":0,1:1) ;routing slip "RTN","SDESBLKANDMOVE",165,0) Q "RTN","SDESBLKANDMOVE",166,0) ; "RTN","SDESBLKANDMOVE",167,0) APPDEL(SDECAPPTIEN) ;Call APPDEL RPC to cancel the current appointment "RTN","SDESBLKANDMOVE",168,0) ;Input: "RTN","SDESBLKANDMOVE",169,0) ; SDECAPPTIEN [REQ] - IEN of appointment to cancel "RTN","SDESBLKANDMOVE",170,0) ;Assume: "RTN","SDESBLKANDMOVE",171,0) ; SDAPPT - Array of data returned by the RPC "RTN","SDESBLKANDMOVE",172,0) ;Output: "RTN","SDESBLKANDMOVE",173,0) ; Any errors logged by call to APPDEL RPC "RTN","SDESBLKANDMOVE",174,0) N RET,TEXT,SDCANRSN,SDUSRNOTE,SDCANDT "RTN","SDESBLKANDMOVE",175,0) S SDCANRSN="BLOCK AND MOVE" "RTN","SDESBLKANDMOVE",176,0) D APPDEL^SDEC08(.RET,APPTIEN,"C",SDCANRSN) "RTN","SDESBLKANDMOVE",177,0) S TEXT=$G(^TMP("SDEC08",$J,"APPDEL",1)) "RTN","SDESBLKANDMOVE",178,0) S TEXT=$P(TEXT,$C(30)) "RTN","SDESBLKANDMOVE",179,0) I TEXT'="" D "RTN","SDESBLKANDMOVE",180,0) .S POP=1 D ERRLOG^SDESJSON(.SDAPPT,52,TEXT,"APPDEL^SDESAPPTSET") "RTN","SDESBLKANDMOVE",181,0) K ^TMP("SDEC08",$J) "RTN","SDESBLKANDMOVE",182,0) Q "RTN","SDESBLKANDMOVE",183,0) ; "RTN","SDESBLKANDMOVE",184,0) APPADD(SDECAPPTIEN,SDECSTART,SDECLEN,SDECRES) ;entry point before calling APPADD^SDEC07 "RTN","SDESBLKANDMOVE",185,0) ;Input: "RTN","SDESBLKANDMOVE",186,0) ; SDECAPPTIEN [REQ] - The IEN from SDEC APPOINTMENT File #409.84 "RTN","SDESBLKANDMOVE",187,0) ; SDECSTART [REQ] - The internal format of Appointment Start Time "RTN","SDESBLKANDMOVE",188,0) ; SDECLEN [REQ] - Appointment length based on Time Scale from 409.831 "RTN","SDESBLKANDMOVE",189,0) ; SDECRES [REQ] - The IEN from SDEC RESOURCE File #409.831. "RTN","SDESBLKANDMOVE",190,0) ; "RTN","SDESBLKANDMOVE",191,0) ;Assume: "RTN","SDESBLKANDMOVE",192,0) ; APPTARY - Array of data from 409.84 for SDECAPPTIEN "RTN","SDESBLKANDMOVE",193,0) ; SDAPPT - Array of data returned by the RPC "RTN","SDESBLKANDMOVE",194,0) ; "RTN","SDESBLKANDMOVE",195,0) ;Output: "RTN","SDESBLKANDMOVE",196,0) ; Errors logged by call to APPADD or set NEWAPPTIEN "RTN","SDESBLKANDMOVE",197,0) ; "RTN","SDESBLKANDMOVE",198,0) N SDRET,SDDFN,SDECNOTE,SDECATID,SDECCR,SDDDT,SDAPTYP,SDCL,SDEL,SDECY,OVB,SDECEND "RTN","SDESBLKANDMOVE",199,0) K ^TMP("SDEC07",$J) "RTN","SDESBLKANDMOVE",200,0) S SDDFN=$G(APPTARY(FN,SDECAPPTIENS,.05,"I")) ;Patient ID/DFN "RTN","SDESBLKANDMOVE",201,0) S SDCL=$P($G(^SDEC(409.831,+SDECRES,0)),U,4) ;Clinic IEN pointer to HOSPITAL LOCATION file 44 "RTN","SDESBLKANDMOVE",202,0) S SDECEND=$$FMADD^XLFDT(SDECSTART,,,+SDECLEN) ;Appointment end time if SDECEND passed in as NULL "RTN","SDESBLKANDMOVE",203,0) S SDECNOTE=$G(APPTARY(FN,SDECAPPTIENS,1,1)) ;Note "RTN","SDESBLKANDMOVE",204,0) S SDECATID=$G(APPTARY(FN,SDECAPPTIENS,.13,"E")) ;WALKIN - WALKIN flag y=YES; n=NO default to NO "RTN","SDESBLKANDMOVE",205,0) I SDECATID=""!(SDECATID="NO") S SDECATID=$P($G(^DPT(SDDFN,"S",SDECSTART,0)),U,7) ;get the purpose of visit in the patient file if NULL in file 409.84 "RTN","SDESBLKANDMOVE",206,0) S SDECATID=$S(SDECATID="YES"!(SDECATID=4):"WALKIN",1:SDECATID) "RTN","SDESBLKANDMOVE",207,0) S SDECCR=$S(SDECATID="WALKIN":0,1:1) ;routing slip "RTN","SDESBLKANDMOVE",208,0) S SDDDT=$G(APPTARY(FN,SDECAPPTIENS,.02,"I")) ;desired date of appointment "RTN","SDESBLKANDMOVE",209,0) S SDAPTYP=$G(APPTARY(FN,SDECAPPTIENS,.22,"E")) ;Appointment Request Type "RTN","SDESBLKANDMOVE",210,0) S SDAPTYP=$S(SDAPTYP="APPT":"A",SDAPTYP="RECALL":"R",SDAPTYP="CONSULT":"C",SDAPTYP="EWL":"E",1:"") "RTN","SDESBLKANDMOVE",211,0) S SDAPTYP=SDAPTYP_"|"_$P(APPTARY(FN,SDECAPPTIENS,.22,"I"),";") "RTN","SDESBLKANDMOVE",212,0) S OVB=0 ;OVERBOOK Flag where 0=no (allow APPADD to check if the new appt will be an Overbook) "RTN","SDESBLKANDMOVE",213,0) ; 1=yes (force appt to be considerd an Overbook) "RTN","SDESBLKANDMOVE",214,0) S SDEL=$P($G(^DPT(SDDFN,.36)),U,1) ;Current Eligibility Code "RTN","SDESBLKANDMOVE",215,0) K SDECY "RTN","SDESBLKANDMOVE",216,0) D APPADD^SDEC07(.SDECY,$$FMTE^XLFDT(SDECSTART),$$FMTE^XLFDT(SDECEND),SDDFN,SDECRES,SDECLEN,$G(SDECNOTE),SDECATID,,,,,,,,SDAPTYP,,,SDCL,,,,,OVB,,SDEL) ;ADD NEW APPOINTMENT "RTN","SDESBLKANDMOVE",217,0) ; "RTN","SDESBLKANDMOVE",218,0) N CNTR,ERROR "RTN","SDESBLKANDMOVE",219,0) S ERROR="" "RTN","SDESBLKANDMOVE",220,0) S CNTR=$O(^TMP("SDEC07",$J,0)) "RTN","SDESBLKANDMOVE",221,0) I CNTR S ERROR=$G(^TMP("SDEC07",$J,CNTR)) "RTN","SDESBLKANDMOVE",222,0) S ERROR=$$CTRL^XMXUTIL1(ERROR) "RTN","SDESBLKANDMOVE",223,0) I $P(ERROR,"^",2)'="" D "RTN","SDESBLKANDMOVE",224,0) .S POP=1 "RTN","SDESBLKANDMOVE",225,0) .D ERRLOG^SDESJSON(.SDAPPT,52,$P(ERROR,"^",2),"APPADD^SDESAPPTSET") "RTN","SDESBLKANDMOVE",226,0) E S NEWAPPTIEN=$P(ERROR,"^",1) "RTN","SDESBLKANDMOVE",227,0) ; "RTN","SDESBLKANDMOVE",228,0) K ^TMP("SDEC07",$J) "RTN","SDESBLKANDMOVE",229,0) Q "RTN","SDESBLKANDMOVE",230,0) ; "RTN","SDESBLKANDMOVE",231,0) PREBLOCK(FROMDTFM,FROMTIMESCALE,FROMRES,SDORGCLIEN,SDDATA44SL,TOTSLOTSUSED) ; "RTN","SDESBLKANDMOVE",232,0) ; 1st call to block original slots "RTN","SDESBLKANDMOVE",233,0) N SDINDX,SLOTS,MOVINGSTRT "RTN","SDESBLKANDMOVE",234,0) ; If orig appt occupied more than 1 slot in a variable length clinic, block the additional slots "RTN","SDESBLKANDMOVE",235,0) S MOVINGSTRT=FROMDTFM "RTN","SDESBLKANDMOVE",236,0) F SLOTS=1:1:TOTSLOTSUSED D "RTN","SDESBLKANDMOVE",237,0) .S SDECEND=$$FMADD^XLFDT(MOVINGSTRT,,,+FROMTIMESCALE) "RTN","SDESBLKANDMOVE",238,0) .D BLOCK($P(MOVINGSTRT,".",1),$P(MOVINGSTRT,".",2),$P(SDECEND,".",2),SDORGCLIEN,SDDATA44SL,FROMTIMESCALE) "RTN","SDESBLKANDMOVE",239,0) .S MOVINGSTRT=$$FMADD^XLFDT(MOVINGSTRT,,,+FROMTIMESCALE) "RTN","SDESBLKANDMOVE",240,0) ; Block any additional slots after original slot (20 to a 60 needs to block 2 additional slots) "RTN","SDESBLKANDMOVE",241,0) S SDINDX="" "RTN","SDESBLKANDMOVE",242,0) F S SDINDX=$O(SDSLOT2BLK(SDINDX)) Q:'SDINDX D "RTN","SDESBLKANDMOVE",243,0) .S SDECEND=$$FMADD^XLFDT($P(FROMDTFM,".",1)_SDINDX,,,+FROMTIMESCALE) "RTN","SDESBLKANDMOVE",244,0) .D BLOCK($P(FROMDTFM,".",1),SDINDX,$P(SDECEND,".",2),SDORGCLIEN,SDDATA44SL,FROMTIMESCALE) "RTN","SDESBLKANDMOVE",245,0) Q "RTN","SDESBLKANDMOVE",246,0) ; "RTN","SDESBLKANDMOVE",247,0) BLOCK(SDSTDATE,SDSTTIME,SDENDTIME,SDORGCLIEN,SDDATA44SL,TIMESCALE) ; Logic copied from routine SDC "RTN","SDESBLKANDMOVE",248,0) N A,CANREM,DA,DFN,DH,I,FR,NOAP,P,SD,SDCNT,SDDATA0,STARTDAY,SDDFR,SDHTO,SI,ST,TO,X,Y,% "RTN","SDESBLKANDMOVE",249,0) S SC=SDORGCLIEN "RTN","SDESBLKANDMOVE",250,0) ; If the resource on the new IEN = resource on origial IEN, no need to block "RTN","SDESBLKANDMOVE",251,0) ; Determine timeslot equivalent "RTN","SDESBLKANDMOVE",252,0) S %=$S(TIMESCALE=10:6,TIMESCALE=20:3,TIMESCALE=15:4,TIMESCALE=30:2,1:1) "RTN","SDESBLKANDMOVE",253,0) S SI=$S(%="":4,%<3:4,%:%,1:4) "RTN","SDESBLKANDMOVE",254,0) S %=$P(SDDATA44SL,U,3),STARTDAY=$S($L(%):%,1:8) D NOW^%DTC S SDTIME=% "RTN","SDESBLKANDMOVE",255,0) S (CANREM,I)="BLOCK AND MOVE" "RTN","SDESBLKANDMOVE",256,0) S SD=SDSTDATE "RTN","SDESBLKANDMOVE",257,0) S X=SDSTTIME_"0000",X=$E(X,1,4) D TC "RTN","SDESBLKANDMOVE",258,0) S FR=Y,ST=% "RTN","SDESBLKANDMOVE",259,0) S X=SDENDTIME_"0000",X=$E(X,1,4) D TC "RTN","SDESBLKANDMOVE",260,0) S SDHTO=X,TO=Y,SDDFR=TO-FR "RTN","SDESBLKANDMOVE",261,0) I '$D(^SC(SC,"SDCAN",0)) S ^SC(SC,"SDCAN",0)="^44.05D^"_FR_"^1" G SKIP "RTN","SDESBLKANDMOVE",262,0) S A=^SC(SC,"SDCAN",0),SDCNT=$P(A,"^",4),^SC(SC,"SDCAN",0)=$P(A,"^",1,2)_"^"_FR_"^"_(SDCNT+1) "RTN","SDESBLKANDMOVE",263,0) SKIP S ^SC(SC,"SDCAN",FR,0)=FR_"^"_SDHTO "RTN","SDESBLKANDMOVE",264,0) S NOAP=$S($O(^SC(SC,"S",(FR-.0001)))'>0:1,$O(^SC(SC,"S",(FR-.0001)))>TO:1,1:0) I 'NOAP S NOAP=$S($O(^SC(SC,"S",+$O(^SC(SC,"S",(FR-.0001))),0))="MES":1,1:0) "RTN","SDESBLKANDMOVE",265,0) S ^SC(SC,"S",FR,0)=FR,^SC(SC,"S",FR,"MES")="CANCELLED UNTIL "_X_$S(I?.P:"",1:" ("_I_")") "RTN","SDESBLKANDMOVE",266,0) D S S I=^SC(SC,"ST",SD,1),I=I_$J("",%-$L(I)),Y="" I $G(SDDFR)<100,$L(I)<77 S I=I_" " ;SD*5.3*758 - pad 4 empty spaces needed for blocks < 60 minutes "RTN","SDESBLKANDMOVE",267,0) F X=0:2:% S DH=$E(I,X+SI+SI),P=$S(X0 D "RTN","SDESBLKANDMOVE",276,0) .I '$D(^SC(SC,"S",FR,1,SDI,0)) I $D(^("C")) S J=FR,J2=SDI D DELETE^SDC1 K J,J2 Q ;SD*5.3*545 delete corrupt node "RTN","SDESBLKANDMOVE",277,0) .I '+$G(^SC(SC,"S",FR,1,SDI,0)) S J=FR,J2=SDI D DELETE^SDC1 K J,J2 Q ;SD*5.3*545 if DFN is missing delete record "RTN","SDESBLKANDMOVE",278,0) .Q:$P(^SC(SC,"S",FR,1,SDI,0),"^",9)="C" ;SD*5.3*758 - Quit processing if appointment already canceled. "RTN","SDESBLKANDMOVE",279,0) .S DFN=+^SC(SC,"S",FR,1,SDI,0),SDCNHDL=$$HANDLE^SDAMEVT(1) "RTN","SDESBLKANDMOVE",280,0) .D BEFORE^SDAMEVT(.SDATA,DFN,FR,SC,SDI,SDCNHDL) "RTN","SDESBLKANDMOVE",281,0) .S $P(^SC(SC,"S",FR,1,SDI,0),"^",9)="C" "RTN","SDESBLKANDMOVE",282,0) .S:$D(^DPT(DFN,"S",FR,0)) NODE=^(0) ;added SD/523 "RTN","SDESBLKANDMOVE",283,0) .Q:$P(NODE,U,1)'=SC ;added SD/523 "RTN","SDESBLKANDMOVE",284,0) .S ^DPT("ASDCN",SC,FR,DFN)="" "RTN","SDESBLKANDMOVE",285,0) .S SDSC=SC,SDTTM=FR,SDPL=SDI,TDH=DH,TMPD=CANREM D CANCEL^SDCNSLT S DH=TDH ;SD/478 "RTN","SDESBLKANDMOVE",286,0) .I $D(^DPT(DFN,"S",FR,0)),$P(^(0),"^",2)'["C" S $P(^(0),"^",2)="C",$P(^(0),"^",12)=DUZ,$P(^(0),"^",14)=SDTIME,DH=DH+1,TDH=DH,DIE="^DPT(DFN,"_"""S"""_",",DR="17///^S X=CANREM",DA=FR D ^DIE S DH=TDH D MORE "RTN","SDESBLKANDMOVE",287,0) .D SDEC^SDCNP0(DFN,FR,SC,"C","",$G(CANREM),SDTIME,DUZ) ;alb/sat 627 "RTN","SDESBLKANDMOVE",288,0) G C "RTN","SDESBLKANDMOVE",289,0) ; "RTN","SDESBLKANDMOVE",290,0) MORE I $D(^SC("ARAD",SC,FR,DFN)) S ^(DFN)="N" "RTN","SDESBLKANDMOVE",291,0) N SDV1 "RTN","SDESBLKANDMOVE",292,0) S SDIV=$S($P(^SC(SC,0),"^",15)]"":$P(^(0),"^",15),1:" 1"),SDV1=$S(SDIV:SDIV,1:+$O(^DG(40.8,0))) I $D(^DPT("ASDPSD","C",SDIV,SC,FR,DFN)) K ^(DFN) "RTN","SDESBLKANDMOVE",293,0) ; SD*724 - set SDPL with value from SDI "RTN","SDESBLKANDMOVE",294,0) S SDH=DH,SDTTM=FR,SDSC=SC,SDPL=SDI,SDRT="D" D RT^SDUTL "RTN","SDESBLKANDMOVE",295,0) S DH=SDH K SDH D CK1,EVT "RTN","SDESBLKANDMOVE",296,0) K SD1,SDIV,SDPL,SDRT,SDSC,SDTTM,SDX Q "RTN","SDESBLKANDMOVE",297,0) CK1 S SDX=0 F SD1=FR\1:0 S SD1=$O(^DPT(DFN,"S",SD1)) Q:'SD1!((SD1\1)'=(FR\1)) I $P(^(SD1,0),"^",2)'["C",$P(^(0),"^",2)'["N" S SDX=1 Q "RTN","SDESBLKANDMOVE",298,0) Q:SDX F SD1=2,4 I $D(^SC("AAS",SD1,FR\1,DFN)) S SDX=1 Q "RTN","SDESBLKANDMOVE",299,0) Q:SDX IF $D(^SCE(+$$EXAE^SDOE(DFN,FR\1,FR\1),0)) S SDX=1 "RTN","SDESBLKANDMOVE",300,0) Q:SDX K ^DPT("ASDPSD","B",SDIV,FR\1,DFN) Q "RTN","SDESBLKANDMOVE",301,0) ; "RTN","SDESBLKANDMOVE",302,0) EVT ; -- separate tag if need to NEW vars "RTN","SDESBLKANDMOVE",303,0) ; -- cancel event "RTN","SDESBLKANDMOVE",304,0) N FR,I,SDTIME,DH,SC "RTN","SDESBLKANDMOVE",305,0) D CANCEL^SDAMEVT(.SDATA,DFN,SDTTM,SDSC,SDPL,0,SDCNHDL) K SDATA,SDCNHDL "RTN","SDESBLKANDMOVE",306,0) Q "RTN","SDESBLKANDMOVE",307,0) ; "RTN","SDESBLKANDMOVE",308,0) BUILDER ;Convert data to JSON "RTN","SDESBLKANDMOVE",309,0) N JSONERR "RTN","SDESBLKANDMOVE",310,0) S JSONERR="" "RTN","SDESBLKANDMOVE",311,0) D ENCODE^SDESJSON(.SDAPPT,.RETURN,.JSONERR) "RTN","SDESBLKANDMOVE",312,0) Q "RTN","SDESBLKANDMOVE",313,0) ; "RTN","SDESBLKANDMOVE",314,0) TC N %DT S X=$$FMTE^XLFDT(SD)_"@"_X,%DT="T" D ^%DT I Y<0!(X["?") Q "RTN","SDESBLKANDMOVE",315,0) S X=$E($P(Y_"0000",".",2),1,4),%=$E(X,3,4),%=X\100-STARTDAY*SI+(%*SI\60)*2 I %<0 S Y=-1 "RTN","SDESBLKANDMOVE",316,0) I %>72 S Y=-1 "RTN","SDESBLKANDMOVE",317,0) Q "RTN","SDESJSON") 0^2^B28507962^B17395672 "RTN","SDESJSON",1,0) SDESJSON ;ALB/MGD/TAW - VISTA SCHEDULING JSON UTILITES ;Sep 15, 2021 "RTN","SDESJSON",2,0) ;;5.3;Scheduling;**788,794,797**Aug 13, 1993;Build 6;Build 8 "RTN","SDESJSON",3,0) ;;Per VHA Directive 6402, this routine should not be modified "RTN","SDESJSON",4,0) Q "RTN","SDESJSON",5,0) ; This routine documents the entry points for the new ??? GUI. "RTN","SDESJSON",6,0) ; "RTN","SDESJSON",7,0) ENCODE(SDESINP,SDESOUT,SDESERR) ; "RTN","SDESJSON",8,0) ; Input: SDESINP = Required: Properly formatted input array to convert to JSON "RTN","SDESJSON",9,0) ; SDESOUT = Required: Name of string to return to Broker "RTN","SDESJSON",10,0) ; SDESERR = Optional: Name of string for error messages. "RTN","SDESJSON",11,0) ; Output: "RTN","SDESJSON",12,0) ; SDESOUT = JSON formatted string "RTN","SDESJSON",13,0) ; SDESERR = Still under development by Kernel "RTN","SDESJSON",14,0) ; "RTN","SDESJSON",15,0) ; Validate Input Parameters "RTN","SDESJSON",16,0) I '$D(SDESINP) D ERRLOG(.SDESINP,52,"Input Data Required.") "RTN","SDESJSON",17,0) D ENCODE^XLFJSON("SDESINP","SDESOUT","SDESERR") "RTN","SDESJSON",18,0) Q "RTN","SDESJSON",19,0) ; "RTN","SDESJSON",20,0) ERRLOG(SDESIN,SDESERRNUM,SDESOPTMSG,SDESRINFO) ; "RTN","SDESJSON",21,0) ; Input: SDESIN = Required: Array name with related data to be logged "RTN","SDESJSON",22,0) ; SDESERRNUM = Required: Error # to return "RTN","SDESJSON",23,0) ; SDESOPTMSG = Optional message string to append to existing error in table "RTN","SDESJSON",24,0) ; SDESRINFO = Optional message string with Routine^Tag info to append to existing error in table "RTN","SDESJSON",25,0) N SDESCNT "RTN","SDESJSON",26,0) S SDESOPTMSG=$G(SDESOPTMSG),SDESRINFO=$G(SDESRINFO) "RTN","SDESJSON",27,0) I '$D(SDESIN) S SDESIN("Error",0)="" "RTN","SDESJSON",28,0) S SDESERRNUM=$G(SDESERRNUM,0) "RTN","SDESJSON",29,0) S SDESCNT=$O(SDESIN("Error",""),-1)+1 "RTN","SDESJSON",30,0) S SDESIN("Error",SDESCNT)=$$ERRLKUP(SDESERRNUM,SDESOPTMSG,SDESRINFO) "RTN","SDESJSON",31,0) K SDESIN("Error",0) "RTN","SDESJSON",32,0) Q "RTN","SDESJSON",33,0) ; "RTN","SDESJSON",34,0) ERRLKUP(SDNUM,SDESOPTMSG,SDESRINFO) ; "RTN","SDESJSON",35,0) N SDERRMSG "RTN","SDESJSON",36,0) S SDERRMSG=$T(ERRTXT+SDNUM+1) "RTN","SDESJSON",37,0) S SDERRMSG=$P(SDERRMSG,U,2) "RTN","SDESJSON",38,0) I SDERRMSG="" S SDERRMSG="Invalid Error Number." "RTN","SDESJSON",39,0) I $G(SDESOPTMSG)'="" D "RTN","SDESJSON",40,0) . ;Strip off $C(30) and $c(31) that are part of non JSON error text "RTN","SDESJSON",41,0) . S SDESOPTMSG=$$CTRL^XMXUTIL1(SDESOPTMSG) "RTN","SDESJSON",42,0) . I $E(SDERRMSG,$L(SDERRMSG))="." S SDERRMSG=$E(SDERRMSG,1,$L(SDERRMSG)-1) "RTN","SDESJSON",43,0) . S SDERRMSG=SDERRMSG_": "_SDESOPTMSG "RTN","SDESJSON",44,0) I $E(SDERRMSG,$L(SDERRMSG))'="." S SDERRMSG=SDERRMSG_"." "RTN","SDESJSON",45,0) ; Add optional Debug info "RTN","SDESJSON",46,0) I SDESRINFO'="" S SDERRMSG=SDERRMSG_" Debug: "_SDESRINFO "RTN","SDESJSON",47,0) Q SDERRMSG "RTN","SDESJSON",48,0) ; "RTN","SDESJSON",49,0) ; Standard Error Messages. Add additional errors as needed. "RTN","SDESJSON",50,0) ; Limit new error messages to 30 characters. "RTN","SDESJSON",51,0) ERRTXT ; "RTN","SDESJSON",52,0) ;;0^No Error Number Provided "RTN","SDESJSON",53,0) ;;1^Missing Patient ID "RTN","SDESJSON",54,0) ;;2^Invalid Patient ID "RTN","SDESJSON",55,0) ;;3^Missing Appointment Request ID "RTN","SDESJSON",56,0) ;;4^Invalid Appointment Request ID "RTN","SDESJSON",57,0) ;;5^Missing Consult Request ID "RTN","SDESJSON",58,0) ;;6^Invalid Consult Request ID "RTN","SDESJSON",59,0) ;;7^No Recalls for this patient "RTN","SDESJSON",60,0) ;;8^No Consults for patient "RTN","SDESJSON",61,0) ;;9^Missing begin date "RTN","SDESJSON",62,0) ;;10^Missing end date "RTN","SDESJSON",63,0) ;;11^Invalid begin date "RTN","SDESJSON",64,0) ;;12^Invalid end date "RTN","SDESJSON",65,0) ;;13^End date prior to begin date "RTN","SDESJSON",66,0) ;;14^Missing Appointment ID "RTN","SDESJSON",67,0) ;;15^Invalid Appointment ID "RTN","SDESJSON",68,0) ;;16^Missing Recall ID "RTN","SDESJSON",69,0) ;;17^Invalid Recall ID "RTN","SDESJSON",70,0) ;;18^Missing Clinic ID "RTN","SDESJSON",71,0) ;;19^Invalid Clinic ID "RTN","SDESJSON",72,0) ;;20^Clinic not defined "RTN","SDESJSON",73,0) ;;21^Missing Check In Date "RTN","SDESJSON",74,0) ;;22^Invalid Check In Date "RTN","SDESJSON",75,0) ;;23^Missing Check Out Date "RTN","SDESJSON",76,0) ;;24^Invalid Check Out Date "RTN","SDESJSON",77,0) ;;25^Missing begin date/time "RTN","SDESJSON",78,0) ;;26^Missing end date/time "RTN","SDESJSON",79,0) ;;27^Invalid begin date/time "RTN","SDESJSON",80,0) ;;28^Invalid end date/time "RTN","SDESJSON",81,0) ;;29^End date/time prior to begin date/time "RTN","SDESJSON",82,0) ;;30^No status match found "RTN","SDESJSON",83,0) ;;31^Appointment status is cancelled "RTN","SDESJSON",84,0) ;;32^Duplicate status entry "RTN","SDESJSON",85,0) ;;33^No statuses available "RTN","SDESJSON",86,0) ;;34^Status not created "RTN","SDESJSON",87,0) ;;35^Status not updated "RTN","SDESJSON",88,0) ;;36^Status not set "RTN","SDESJSON",89,0) ;;37^Status not found "RTN","SDESJSON",90,0) ;;38^No status sent "RTN","SDESJSON",91,0) ;;39^Status is less than 3 characters or greater than 30 characters "RTN","SDESJSON",92,0) ;;40^Missing check-in step ID "RTN","SDESJSON",93,0) ;;41^Status must contain characters "RTN","SDESJSON",94,0) ;;42^Missing Disposition "RTN","SDESJSON",95,0) ;;43^Invalid Disposition "RTN","SDESJSON",96,0) ;;44^Invalid user "RTN","SDESJSON",97,0) ;;45^Missing date "RTN","SDESJSON",98,0) ;;46^Invalid date "RTN","SDESJSON",99,0) ;;47^Failed create/update "RTN","SDESJSON",100,0) ;;48^Missing Origination date/time "RTN","SDESJSON",101,0) ;;49^Invalid Origination date/time "RTN","SDESJSON",102,0) ;;50^Missing Clinic name "RTN","SDESJSON",103,0) ;;51^Invalid Clinic Name "RTN","SDESJSON",104,0) ;;52^Error "RTN","SDESJSON",105,0) ;;53^Missing Provider ID "RTN","SDESJSON",106,0) ;;54^Invalid Provider ID "RTN","SDESJSON",107,0) ;;55^Invalid Disposition Date "RTN","SDESJSON",108,0) ;;56^Missing Disposition Date "RTN","SDESJSON",109,0) ;;57^Missing Desired Date Of Appointment "RTN","SDESJSON",110,0) ;;58^Invalid Desired Date Of Appointment "RTN","SDESJSON",111,0) ;;59^Desired Date of Appt can not be in the past "RTN","SDESJSON",112,0) ;;60^Missing Appointment Request Type "RTN","SDESJSON",113,0) ;;61^Invalid Appointment Request Type "RTN","SDESJSON",114,0) ;;62^Missing Requested By "RTN","SDESJSON",115,0) ;;63^Clinic Name or Clinic Stop is required "RTN","SDESJSON",116,0) ;;64^Search String length is less than 2 characters "RTN","SDESJSON",117,0) ;;65^No Providers found that match Search String "RTN","SDESJSON",118,0) ;;66^Patient IEN cannot be blank "RTN","SDESJSON",119,0) ;;67^Clinic IEN cannot be blank "RTN","SDESJSON",120,0) ;;68^No VVS information found "RTN","SDESJSON",121,0) ;;69^Missing Clinic Resource ID "RTN","SDESJSON",122,0) ;;70^Invalid Clinic Resource ID "RTN","SDESJSON",123,0) ;;71^Date can not be in the past "RTN","SDESJSON",124,0) ;;72^Date can not be in the future "RTN","SDESJSON",125,0) ;;73^Clinic Resource is missing "RTN","SDESJSON",126,0) ;;74^Current appt time span is greater then new appt time span "RTN","SDESJSON",127,0) ;;75^No available appointment slots "RTN","SDESJSON",128,0) ;;76^Missing Appointment date/time "RTN","SDESJSON",129,0) ;;77^Invalid Appointment date/time "RTN","SDESJSON",130,0) ;;78^Appointment must be in a scheduled state "RTN","SDESJSON",131,0) ;;79^Slots for Block & Move not identifiable "RTN","SDESJSON",132,0) Q "RTN","SDM0") 0^11^B107738621^B106931874 "RTN","SDM0",1,0) SDM0 ;SF/GFT,ANU - MAKE APPOINTMENT ;1/5/16 12:26pm "RTN","SDM0",2,0) ;;5.3;Scheduling;**140,167,206,186,223,237,241,384,334,547,621,622,645,674,726,796,797**;Aug 13, 1993;Build 8 "RTN","SDM0",3,0) ;;Per VHA Directive 6402, this routine should not be modified "RTN","SDM0",4,0) I $D(SDXXX) S SDOK=1 Q "RTN","SDM0",5,0) N SDSRTY,SDDATE,SDSDATE,SDDATE2,SDSRFU,SDDMAX,SDONCE "RTN","SDM0",6,0) ;Prompt for scheduling request type "RTN","SDM0",7,0) M N SDHX,SDXF,SDXD "RTN","SDM0",8,0) Q:'$$SRTY(.SDSRTY) S:SDSRTY SDDATE=DT "RTN","SDM0",9,0) ; SD*5.3*622 - let user see desired date "RTN","SDM0",10,0) ; SD*5.3*645 - replaced DESIRED DATE with CID/PREFERRED DATE "RTN","SDM0",11,0) I $D(SDDATE) S Y=SDDATE,SDDATE2=$$FMTE^XLFDT(Y) W !!,"APPOINTMENT CID/PREFERRED DATE: "_SDDATE2 W ! H 3 "RTN","SDM0",12,0) ;Calculate appointment follow-up indicator "RTN","SDM0",13,0) S SDSRFU=$$PTFU(DFN,SC) "RTN","SDM0",14,0) ;Determine maximum days for scheduling "RTN","SDM0",15,0) S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365 "RTN","SDM0",16,0) S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1)) "RTN","SDM0",17,0) ; SD*5.3*796 - Anu - Remove prompt for PID and default to today's date "RTN","SDM0",18,0) ;Prompt for desired date "RTN","SDM0",19,0) ;Q:'$$DDATE(.SDDATE,SDSRTY,.SDMAX) "RTN","SDM0",20,0) S SDDATE=DT "RTN","SDM0",21,0) ; SD*5.3*796 - Anu - Remove prompt - End "RTN","SDM0",22,0) ;If date and time, schedule appt. directly "RTN","SDM0",23,0) W ! I SDDATE#1 S SDSDATE=SDDATE,SDDATE=SDDATE\1 G ^SDM1 "RTN","SDM0",24,0) S (X,Y)=SDDATE K SDHX "RTN","SDM0",25,0) ;Find first available after specified date "RTN","SDM0",26,0) I X="F"!(X="f") D SUP,DT1 G NEXT "RTN","SDM0",27,0) ;Find next available appointment "RTN","SDM0",28,0) I SDSRTY,SDDATE D SUP S SDSTRTDT=SDDATE D OVR^SDMULT0 G NEXT "RTN","SDM0",29,0) ; "RTN","SDM0",30,0) EN S:$L(X)=1 X=$TR(X,"tnN","TTT") S:X="NOW" X="T" I X?.A!(+X=X),X<13,X'?1"T".E S X=X_" 1" "RTN","SDM0",31,0) D Q:Y<1 "RTN","SDM0",32,0) .N %DT "RTN","SDM0",33,0) .S %DT="T" D ^%DT "RTN","SDM0",34,0) .I Y<1 W !!,"Unable to evaluate date value """_X_""".",! "RTN","SDM0",35,0) .Q "RTN","SDM0",36,0) S:$S($D(DUZ)'[0:1,1:0) ^DISV(DUZ_U_+SC)=Y "RTN","SDM0",37,0) DISP S IOF=$S('$D(IOF):"!#",IOF']"":"!#",1:IOF) W @IOF S SDSOH=$S('$D(^SC(+SC,"SL")):0,$P(^("SL"),"^",8)']"":0,1:1),SDAV=0 "RTN","SDM0",38,0) I $D(SDINA),Y'Y!('SDRE) S SDHY=Y,Y=SDINA D DTS^SDUTL W !,*7,"Clinic is inactive ",$S(SDRE:"from ",1:"as of "),Y S Y=SDRE D:Y DTS^SDUTL W $S(SDRE:" to "_Y,1:"") S Y=SDHY K SDHY D PAUSE^VALM1 Q:'SDRE "RTN","SDM0",39,0) S:Y#100=0 Y=Y+1 S X=Y D D:$E(X,4,5) S (SDX,X1)=X,X2=1 D C^%DTC S X=SDX K SDX G:SDAV ^SDM1 Q "RTN","SDM0",40,0) ; "RTN","SDM0",41,0) NEXT D SET I $S('$D(FND):1,'FND:1,1:0) D G EN "RTN","SDM0",42,0) .K ^DISV($S($D(DUZ)'[0:DUZ,1:0)_U_+SC) "RTN","SDM0",43,0) .I '$O(^SC(+SC,"ST",SDDATE-1)) S (X,Y)=SDDATE Q "RTN","SDM0",44,0) .W $C(7),!?6,"No open slots found in the date range " "RTN","SDM0",45,0) .W $$FMTE^XLFDT(SDDATE)," to ",$$FMTE^XLFDT(SDDMAX),"!",! "RTN","SDM0",46,0) .H 3 S (X,Y)=SDDATE "RTN","SDM0",47,0) .Q "RTN","SDM0",48,0) S (X,Y)=SDAPP K SDXXX G DISP "RTN","SDM0",49,0) ; SD*5.3*622 - display clinic name all the time "RTN","SDM0",50,0) D W #!?36,$P(^SC(+SC,0),U,1) S:$O(^SC(+SC,"T",0))>X X=+$O(^(0)) D DOW S I=Y+32,D=Y S SDXF=0 D WM I SDXF D WMH "RTN","SDM0",51,0) X1 S X1=X\100_$P("31^28^31^30^31^30^31^31^30^31^30^31",U,+$E(X,4,5)) ;28 "RTN","SDM0",52,0) ;SD*5.3*547 next line don't allow past dates to be added to pattern if prior to date DOW was added "RTN","SDM0",53,0) W I '$D(^SC(+SC,"ST",X,1)) S DWFLG=1,POP=0,XDT=X D DOWCHK K DWFLG,XDT G L:POP "RTN","SDM0",54,0) ;Add date start date check - SD*5.3*674 "RTN","SDM0",55,0) I '$D(^SC(+SC,"ST",X,1)) S Y=D#7 G L:'$D(J(Y)),H:$D(^HOLIDAY(X))&('SDSOH) I '$$BEGDAT(X,Y) S SS=+$O(^SC(+SC,"T"_Y,X)) G L:SS'>0,L:^(SS,1)="" S ^SC(+SC,"ST",$P(X,"."),1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(X,6,7)_$J("",SI+SI-6)_^(1),^(0)=$P(X,".") "RTN","SDM0",56,0) S SDHX=X,SDAV=1 D:X>SM WM I SDXF<2 D WMH "RTN","SDM0",57,0) I $D(^SC(+SC,"ST",X,1)),^(1)["["!(^(1)["CANCELLED")!($D(^HOLIDAY(X))) W !,$E(^SC(+SC,"ST",X,1),1,80) S:'$D(^HOLIDAY(X))&('SDAV) SDAV=1 "RTN","SDM0",58,0) I $Y>18 W ! Q "RTN","SDM0",59,0) L K POP "RTN","SDM0",60,0) S X=X+1,D=D+1 "RTN","SDM0",61,0) I $D(SDINA),X>SDINA,SDRE>X!('SDRE) D:'SDAV NOAV S SDHY=Y,Y=SDINA D DTS^SDUTL W !,*7,?8,"Clinic is inactive ",$S(SDRE:"from ",1:"as of "),Y S Y=SDRE D:Y DTS^SDUTL W $S(SDRE:" to "_Y,1:"") S Y=SDHY K SDHY Q:'SDRE D DIFF "RTN","SDM0",62,0) G W:X'>X1 S X2=X-X1 D C^%DTC "RTN","SDM0",63,0) I $D(SDINA),X>SDINA,SDRE>X!('SDRE) D:'SDAV NOAV S SDHY=Y,Y=SDINA D DTS^SDUTL W !,*7,?8,"Clinic is inactive ",$S(SDRE:"from ",1:"as of "),Y S Y=SDRE D:Y DTS^SDUTL W $S(SDRE:" to "_Y,1:"") S Y=SDHY K SDHY Q:'SDRE "RTN","SDM0",64,0) G X1:D20 D "RTN","SDM0",71,0) . S SDXD=$O(^SC(+SC,"ST",X-1)) Q:SDXD="" "RTN","SDM0",72,0) . I $E(SDXD,4,5)'=$E(X,4,5) S SDXF=0 "RTN","SDM0",73,0) D:SDXF DT "RTN","SDM0",74,0) Q "RTN","SDM0",75,0) WMH ;Write month heading lines "RTN","SDM0",76,0) W !!," TIME",?SI+SI-1 F Y=STARTDAY:1:65\(SI+SI)+STARTDAY W $E("|"_$S('Y:0,1:(Y-1#12+1))_" ",1,SI+SI) "RTN","SDM0",77,0) W !," DATE",?SI+SI-1,"|" K J F Y=0:1:6 I $D(^SC(+SC,"T"_Y)) S J(Y)="" "RTN","SDM0",78,0) F Y=1:1:65\(SI+SI) W $J("|",SI+SI) "RTN","SDM0",79,0) S SDXF=2 "RTN","SDM0",80,0) Q "RTN","SDM0",81,0) DT W $$FMTE^XLFDT(Y) Q "RTN","SDM0",82,0) ; "RTN","SDM0",83,0) DOW S Y=$$DOW^XLFDT(X,1) Q "RTN","SDM0",84,0) ; "RTN","SDM0",85,0) DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR "RTN","SDM0",86,0) MORDIS I '$D(SDHX) W *7," ??" G ADT^SDM1 "RTN","SDM0",87,0) S SDXF=0,X1=SDHX,X2=1 D C^%DTC "RTN","SDM0",88,0) MORD2 I $D(SDINA),SDINA'>X,SDRE>X!('SDRE) S SDHY=$S($D(Y):Y,1:""),Y=SDINA D DTS^SDUTL W *7,!,"Clinic is inactivated as of ",Y S Y=SDHY K SDHY G ADT^SDM1 "RTN","SDM0",89,0) G EN "RTN","SDM0",90,0) INPAT S SDI=$O(^DGPM("ATID1",DFN,9999999-X)) I SDI>0 D I1 "RTN","SDM0",91,0) S:'$D(SDINP) SDINP="" K SDI,SDI1 Q "RTN","SDM0",92,0) I1 F SDI1=0:0 S SDI1=$O(^DGPM("ATID1",DFN,SDI,SDI1)) Q:SDI1'>0 I $D(^DGPM(SDI1,0)) S SDX=^(0) I $S($P(SDX,U,17)']"":1,+^DGPM($P(SDX,U,17),0)>X!(+^DGPM($P(SDX,U,17),0)=0):1,1:0) S SDINP="I" Q "RTN","SDM0",93,0) Q "RTN","SDM0",94,0) ; "RTN","SDM0",95,0) SUP ;Set up variables for availability search "RTN","SDM0",96,0) S SDNEXT=1,SDCT=1,G1=+SC,SDC(1)=SC,FND=0,SDAV=0 K SDC1 "RTN","SDM0",97,0) D SAVE S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP "RTN","SDM0",98,0) Q "RTN","SDM0",99,0) ; "RTN","SDM0",100,0) SET S I1="" F I=0:0 S I1=$O(SDZ(I1)) Q:I1']"" S @I1=SDZ(I1) "RTN","SDM0",101,0) K SDZ Q "RTN","SDM0",102,0) SAVE K SDZ F I="SDDIF","STR","SC","DFN","SL","SI","HSI","SB" S Z="SDZ("_""""_I_""")" S:$D(@I) @Z=@I "RTN","SDM0",103,0) Q "RTN","SDM0",104,0) MNTH W !," *** No availability found for one full calendar month",!," Search stopped at " S Y=X D DTS^SDUTL W Y," ***",! Q "RTN","SDM0",105,0) DIFF S X1=SDRE,X2=X D ^%DTC S D=D+X,X=SDRE,X1=X\100_28 Q "RTN","SDM0",106,0) ; "RTN","SDM0",107,0) SRTY(SDSRTY) ;Prompt for scheduling request type "RTN","SDM0",108,0) ;Input: SDSRTY=variable to return user response (pass by reference) "RTN","SDM0",109,0) ;Output: '1' if successful, '0' otherwise "RTN","SDM0",110,0) ; "RTN","SDM0",111,0) I $G(DFN)<1 S SDSRTY="M" Q 1 ;patient not defined "RTN","SDM0",112,0) I $G(SDMM)=1 S SDSRTY="M" Q 1 ;multiple appointment booking "RTN","SDM0",113,0) N DIR,DTOUT,DUOUT "RTN","SDM0",114,0) S DIR(0)="Y" "RTN","SDM0",115,0) S DIR("A")="IS THIS A 'NEXT AVAILABLE' APPOINTMENT REQUEST" "RTN","SDM0",116,0) S DIR("?")="Answer 'yes' if scheduling to the next available appointment is desired." "RTN","SDM0",117,0) W ! D ^DIR I $D(DTOUT)!$D(DUOUT) Q 0 "RTN","SDM0",118,0) S SDSRTY=Y,SDSRTY(0)=$$TXRT^SDM1A(.SDSRTY) Q 1 "RTN","SDM0",119,0) ; "RTN","SDM0",120,0) PTFU(DFN,SC) ;Determine if this is a follow-up (return to clinic within 24 months) "RTN","SDM0",121,0) ;Input: DFN=patient ifn "RTN","SDM0",122,0) ;Input: SC=clinic ifn "RTN","SDM0",123,0) ;Output: '1' if seen within 24 months, '0' otherwise "RTN","SDM0",124,0) ; "RTN","SDM0",125,0) Q:'DFN!'SC 0 ;variable check "RTN","SDM0",126,0) N SDBDT,SDT,SDX,SDY,SDZ,SDCP,SDCP1,SC0,SDENC,SDCT "RTN","SDM0",127,0) ;set up variables "RTN","SDM0",128,0) S SDBDT=(DT-20000)+.24,SDT=DT_.999999,(SDCT,SDY)=0 "RTN","SDM0",129,0) S SC0=$G(^SC(+SC,0)),SDX=$$CPAIR^SCRPW71(SC0,.SDCP) ;get credit pair for this clinic "RTN","SDM0",130,0) ;Iterate through encounters "RTN","SDM0",131,0) W !!,"Calculating follow-up status" "RTN","SDM0",132,0) F S SDT=$O(^SCE("ADFN",DFN,SDT),-1) Q:SDT0 W !?5,"Date/time",?19,"to schedule a specific appointment - Note: PAST dates",!?19,"must include the Year in the input." ;added note SD*5.3*547 "RTN","SDM0",158,0) W !?5,"'?'",?19,"for detailed help" "RTN","SDM0",159,0) DASK N DIR,X,Y,SDX,DTOUT,DUOUT "RTN","SDM0",160,0) ; "RTN","SDM0",161,0) ;BP OIFO/TEH PATCH SD*5.3*384 ; SD*5.3*547 added note to help text "RTN","SDM0",162,0) ; "RTN","SDM0",163,0) S DIR(0)="F^1:30" "RTN","SDM0",164,0) ; SD*5.3*645 - replaced DATE DESIRED with CID/PREFERRED DATE "RTN","SDM0",165,0) ; S DIR("A")="ENTER THE DATE DESIRED FOR THIS APPOINTMENT" "RTN","SDM0",166,0) S DIR("A")="ENTER THE CID/PREFERRED DATE FOR THIS APPOINTMENT" "RTN","SDM0",167,0) S DIR("?",1)=" Enter the date that is desired for this appointment." "RTN","SDM0",168,0) S DIR("?",2)=" NOTE: PAST dates must include the Year in the input." "RTN","SDM0",169,0) S DIR("?",3)="" "RTN","SDM0",170,0) S DIR("?",4)=" You may enter 'F' to find the first available slot after a specified date." "RTN","SDM0",171,0) S DIR("?",5)=" You will be prompted for begin and end dates for this search." "RTN","SDM0",172,0) S DIR("?",6)="" "RTN","SDM0",173,0) S DIR("?",7)=" A date may be entered to begin the display of clinic availability at the" "RTN","SDM0",174,0) I DFN<1 S DIR("?")=" requested date." "RTN","SDM0",175,0) I DFN>0 D "RTN","SDM0",176,0) .S DIR("?",8)=" requested date." "RTN","SDM0",177,0) .S DIR("?",9)="" "RTN","SDM0",178,0) .S DIR("?",10)=" The entry of a date/time will result in the scheduling of an appointment at" "RTN","SDM0",179,0) .S DIR("?")=" that time, if possible." "RTN","SDM0",180,0) .Q "RTN","SDM0",181,0) W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT) 0 "RTN","SDM0",182,0) I Y=" " S SDX=$G(^DISV(DUZ_U_+SC)) I SDX?7N S (X,Y)=SDX "RTN","SDM0",183,0) I $L(Y)=1,"fF"[Y D Q 1 "RTN","SDM0",184,0) .W " First available" "RTN","SDM0",185,0) .S (SDDATE,SDSRTY)=$TR(Y,"f","F") "RTN","SDM0",186,0) .Q "RTN","SDM0",187,0) N %DT,SDX,SDI,POP "RTN","SDM0",188,0) S SDX="N^n^NOW^now^Now" F SDI=1:1:5 S:X=$P(SDX,U,SDI) X="T" "RTN","SDM0",189,0) S %DT="EFT" D ^%DT "RTN","SDM0",190,0) G:Y<1 DASK S SDDATE=Y "RTN","SDM0",191,0) I DFN<1 S SDDATE=SDDATE\1 "RTN","SDM0",192,0) ;SD*5.3*621 - check if desired date if prior to DOB and if clinic schedule is available. "RTN","SDM0",193,0) I DFN>0 S POP=0 D DDCHK I POP G DASK "RTN","SDM0",194,0) I DFN>0,Y'SDMAX D G DASK "RTN","SDM0",195,0) .W !,$C(7) "RTN","SDM0",196,0) .W "Scheduling cannot be more than ",SDMAX(1)," days in the future" "RTN","SDM0",197,0) .Q "RTN","SDM0",198,0) Q 1 "RTN","SDM0",199,0) ; "RTN","SDM0",200,0) DDCHK ;SD*5.3*621 - check if desired date if prior to DOB and if clinic schedule is available. "RTN","SDM0",201,0) N X "RTN","SDM0",202,0) S X=SDDATE D AVCHK^SDM1 I POP Q "RTN","SDM0",203,0) D AVCHK1^SDM1 "RTN","SDM0",204,0) Q "RTN","SDM0",205,0) ; "RTN","SDM0",206,0) DOWCHK ;SD*5.3*547 check if date is prior to date DOW was added to pattern "RTN","SDM0",207,0) S (DY,DYW)="" S:'$D(DWFLG) DWFLG=0 "RTN","SDM0",208,0) I '$D(^SC(+SC,"ST",$P(XDT,"."),1)) D Q:DWFLG I POP D DWWRT Q "RTN","SDM0",209,0) .S DY=$$DOW^XLFDT($P(XDT,".")) "RTN","SDM0",210,0) .S DYW=$E(DY,1,2),DYW=$TR(DYW,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","SDM0",211,0) .S PCDT=$P(XDT,"."),CT=0,POP=1 "RTN","SDM0",212,0) .F S PCDT=$O(^SC(+SC,"ST",PCDT),-1) Q:'PCDT!('POP)!(CT>30) D "RTN","SDM0",213,0) ..S CT=CT+1 "RTN","SDM0",214,0) ..Q:'$D(^SC(+SC,"ST",PCDT,0)) "RTN","SDM0",215,0) ..Q:'$D(^SC(+SC,"ST",PCDT,1)) "RTN","SDM0",216,0) ..Q:$E($G(^SC(+SC,"ST",PCDT,1)),1,2)'=DYW "RTN","SDM0",217,0) ..I $E($G(^SC(+SC,"ST",PCDT,1)),1,2)=DYW S POP=0 Q "RTN","SDM0",218,0) .Q "RTN","SDM0",219,0) K PCDT,CT,DY,DYW "RTN","SDM0",220,0) Q "RTN","SDM0",221,0) ; "RTN","SDM0",222,0) DWWRT ;added SD*5.3*547 "RTN","SDM0",223,0) S DY=$TR(DY,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","SDM0",224,0) W *7,!!,"That date is prior to the date ",DY," was added to the" "RTN","SDM0",225,0) W !,"availability pattern for this clinic.",!! "RTN","SDM0",226,0) K DY,DYW,PCDT,CT "RTN","SDM0",227,0) Q "RTN","SDM0",228,0) ; "RTN","SDM0",229,0) BEGDAT(SDDT,SDY) ;Add begin date check - SD*5.3*674, Quit 0 if successful, 1 if fails "RTN","SDM0",230,0) N SDX,SDBEG,SDDOW,SDBEGO,SDCNT "RTN","SDM0",231,0) F SDX=0:1:6 S SDDOW(SDX,9999999)="" ;SD*5.3*674 "RTN","SDM0",232,0) S SDBEGO="",SDCNT=0 F S SDCNT=$O(^SC(+SC,"T"_$$DOW^XLFDT(SDDT,1),SDCNT)) Q:'SDCNT S SDBEGO=SDBEGO_U_SDCNT "RTN","SDM0",233,0) S SDX="" F S SDX=$O(^SC(+SC,"T",SDX),-1) Q:'SDX D ;SD*5.3*726 "RTN","SDM0",234,0) .I '$D(^SC(+SC,"OST",SDX))!(($G(^SC(+SC,"T"_$$DOW^XLFDT(SDX,1),9999999,1))'="")&(SDBEGO="^9999999"!(SDBEGO[SDX))) S SDBEG=$G(^SC(+SC,"T",SDX,0),SDX) S SDDOW($$DOW^XLFDT(SDBEG,1),SDBEG)="" ;SD*5.3*674/SD*5.3*726 "RTN","SDM0",235,0) I $O(SDDOW(SDY,(SDDT+1)),-1) Q 0 ;Successful check, Quit 0 "RTN","SDM0",236,0) Q 1 ;Chec failed, Quit 1 "RTN","SDM0",237,0) ; "RTN","SDM0",238,0) 1 S SDNEXT="",SDCT=0 G RD^SDMULT "RTN","SDM0",239,0) DT1 S FND=0,%DT(0)=-SDMAX,%DT="AEF",%DT("A")=" START SEARCH FOR NEXT AVAILABLE FROM WHAT DATE: " D ^%DT K %DT G:"^"[X 1:$S('$D(SDNEXT):1,'SDNEXT:1,1:0),END^SDMULT0 G:Y<0 DT S (SDDATE,SDSTRTDT)=+Y "RTN","SDM0",240,0) LIM W !," ENTER LATEST DATE TO CHECK FOR 1ST AVAILABLE SLOT: " S Y=SDMAX D DT^DIQ R "// ",X:DTIME G:X["^"!'($T) END^SDMULT0 I X']"" G OVR^SDMULT0 "RTN","SDM0",241,0) I X?.E1"?" W !," The latest date for future bookings for ",$P(SDC(1),"^",2)," is: " S Y=SDMAX D DTS^SDUTL W Y,!," If you enter a date here, it must be less than this date to further limit the",!," search" G LIM "RTN","SDM0",242,0) S %DT="EF",%DT(0)=-SDMAX D ^%DT K %DT G:Y<0!(Y0 (SDDMAX,SDMAX)=+Y "RTN","SDM0",243,0) G OVR^SDMULT0 "VER") 8.0^22.2 "BLD",12502,6) ^649 **END** **END**