SCMCWS1 ;ALB/ART - PCMM Web-Call Patient Summary Web Service ;02/06/2015
;;5.3;Scheduling;**603**;Aug 13, 1993;Build 79
;
QUIT
;
;Public, Supported ICRs
; #2053 - Data Base Server API: Editing Utilities (DIE)
; #2056 - Data Base Server API: Data Retriever Utilities (DIQ)
; #4440 - DBIA4440 (XUPROD)
; #5421 - XOBWLIB - Public APIs for HWSC
; #10035 - PATIENT FILE
; #10060 - NEW PERSON FILE
; #10103 - XLFDT - Supported APIs for date & time
; #10112 - VASITE - Supported APIs for site info
;
PCDETAIL(SCDISPLY,SCDFN) ;Call PCMM/R Web Service
;Inputs: SCDISPLY - Array for team assignment info - passed by reference
; SCDFN - Patient DFN
;Output: populated SCDISPLY
; ICR #6027 - SCMC PCMM/R GET PRIMARY CARE DETAILS
;
NEW SCSERVER,SCSERVC,SCLIST,SCSRVRKY,SCRC
NEW SCSTAT,SCEOF,SCREADR,SCCNT,SCARRAY,SCVALUE,SCNODE,SCROW
NEW SCREST,SCGETRC,SCERR
NEW SCTEAMS,SCINPAT,SCNVA,SCBLOCK,SCTMLVL,SCPCLVL,SCNVALVL,SCMHLVL,SCOELVL,SCSPLVL,SCSPTYPE,SCSPMBR
NEW SCDATA,SCX,SCY
;
IF $$PROD^XUPROD DO
. SET SCDATA("serverNameKey")="PCMMR SERVER"
ELSE DO
. SET SCDATA("serverNameKey")="PCMMR TEST SERVER"
SET SCDATA("webServiceName")="PCMM-R GET PC INFO REST"
;
; Web service setup
SET SCRC=+$$SETUP^SCMCWSUT(.SCDATA)
IF SCRC=0 DO QUIT
. SET SCDISPLY(1)=$PIECE(SCRC,U,2)
;
; Get client REST request object
SET SCDATA("restObject")=$$GETREST^XOBWLIB(SCDATA("webServiceName"),SCDATA("serverName"))
;
; Get Local Site ID
;Institution file pointer^Institution name^station number with suffix
SET SCDATA("site")=$PIECE($$SITE^VASITE(),U,3)
;
; Set PCMM/R web service parameters
SET SCDATA("webServiceParameters")="/"_SCDATA("site")_"/"_SCDFN_".xml"
;
; Retrieve the resource; execute HTTP GET method
SET SCGETRC=$$GET^XOBWLIB(SCDATA("restObject"),SCDATA("webServiceParameters"),.SCERR,0)
IF 'SCGETRC DO QUIT
. SET SCRC=$$GET1^DIQ(404.41,SCDFN_",",.07,"","SCDISPLY")
. IF $GET(SCDISPLY(1))="" DO
. . SET SCDISPLY(1)="PCMM is unavailable."
;
; Parse the XML stream
SET SCSTAT=##class(%XML.TextReader).ParseStream(SCDATA("restObject").HttpResponse.Data,.SCREADR)
;
; Check XML parse error
IF 'SCSTAT DO QUIT
. SET SCDISPLY(1)=">>> ERROR reading XML <<<"
. SET SCDISPLY(2)=" Invalid XML Format"
;
; Process XML
SET SCTMLVL=0
SET SCPCLVL=0
SET SCNVALVL=0
SET SCMHLVL=0
SET SCOELVL=0
SET SCSPLVL=0
SET SCSPTYPE=0
SET SCSPMBR=0
SET SCCNT=0
SET SCBLOCK=0
SET SCEOF=0
FOR QUIT:SCEOF!SCREADR.EOF!'SCREADR.Read() DO
. ; Get element value
. IF (SCREADR.NodeType="chars") DO
. . SET SCNODE=SCREADR.Path
. . SET SCVALUE=SCREADR.Value
. . DO PARSEXML^SCMCWS1A(SCNODE,SCVALUE,.SCTEAMS,.SCNVA,.SCTMLVL,.SCPCLVL,.SCNVALVL,.SCMHLVL,.SCOELVL,.SCSPLVL,.SCSPTYPE,.SCSPMBR,.SCBLOCK,.SCEOF)
. ; Check for last closing tag
. IF (SCREADR.NodeType="endelement")&(SCREADR.LocalName="PatientSummary") DO
. . SET SCEOF=1
;
; Get Ipatient Data
DO GETINPAT(SCDFN,.SCINPAT)
;
; Build Display Array
IF 'SCBLOCK DO
. DO BLDISPLY(.SCTEAMS,.SCINPAT,.SCNVA,.SCDISPLY,SCDATA("site"))
ELSE DO
. DO BLDBLOCK(.SCTEAMS,.SCINPAT,.SCDISPLY)
;
;Save display array in OutPatient Profile
SET SCDISPLY(1)="ATTENTION: PCMM is unavailable, data is current as of: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)
DO WP^DIE(404.41,SCDFN_",",.07,"K","SCDISPLY")
SET SCDISPLY(1)=""
;
QUIT
;
;
GETINPAT(SCDFN,SCINPAT) ;Build an array of local attending and inpatient providers
;Inputs: SCDFN - patient DFN
; SCINPAT - inpatient provider array - by reference
;Output: Populated inpatient provider array
;
NEW SCATT,SCPROV
;If patient is assigned to a ward
IF $$GET1^DIQ(2,SCDFN_",",.1)'="" DO
. SET SCATT=$$GET1^DIQ(2,SCDFN_",",.1041,"I")
. SET SCPROV=$$GET1^DIQ(2,SCDFN_",",.104,"I")
. ;populate array from New Person File
. IF +SCATT DO
. . SET SCINPAT("ATT NAME")=$$GET1^DIQ(200,+SCATT_",",.01)
. . SET SCINPAT("ATT PHONE")=$$GET1^DIQ(200,+SCATT_",",.132)
. . SET SCINPAT("ATT PAGER")=$$GET1^DIQ(200,+SCATT_",",.138)
. IF +SCPROV DO
. . SET SCINPAT("PROV NAME")=$$GET1^DIQ(200,+SCPROV_",",.01)
. . SET SCINPAT("PROV PHONE")=$$GET1^DIQ(200,+SCPROV_",",.132)
. . SET SCINPAT("PROV PAGER")=$$GET1^DIQ(200,+SCPROV_",",.138)
QUIT
;
BLDBLOCK(SCTEAMS,SCINPAT,SCDISPLY) ; Build the Display Array
;Inputs: SCTEAMS - Teams array - by reference
; SCINPAT - inpatient array - by reference
; SCDISPLY - Display array - by reference
;Output: Populated Display Array
;
NEW SCDISP,SCSKIP,SCI
;
SET SCDISP=1
SET SCSKIP=0
SET SCDISPLY(SCDISP)=""
;Inpatient providers
IF $GET(SCINPAT("ATT NAME"))'="" DO
. SET SCDISP=SCDISP+1
. SET SCSKIP=1
. SET SCDISPLY(SCDISP)=" Inpatient Attending: "_$GET(SCINPAT("ATT NAME"))_$$FMTPHPG("I","ATT",0)
IF $GET(SCINPAT("PROV NAME"))'="" DO
. SET SCDISP=SCDISP+1
. SET SCSKIP=1
. SET SCDISPLY(SCDISP)=" Inpatient Provider: "_$GET(SCINPAT("PROV NAME"))_$$FMTPHPG("I","PROV",0)
IF SCSKIP DO
. SET SCDISP=SCDISP+1
. SET SCDISPLY(SCDISP)=""
;
FOR SCI=1:1 QUIT:'$DATA(SCTEAMS(SCI)) DO
. SET SCDISP=SCDISP+1
. SET SCDISPLY(SCDISP)=SCTEAMS(SCI)
;
QUIT
;
BLDISPLY(SCTEAMS,SCINPAT,SCNVA,SCDISPLY,SCSITE) ; Build the Display Array
;Inputs: SCTEAMS - Teams array - by reference
; SCINPAT - inpatient array - by reference
; SCNVA - nonVA array - by reference
; SCDISPLY - Display array - by reference
; SCSITE - Site Number
;Output: Populated Display Array
;
NEW SCDISP,SCX,SCY,SCZ,SCLEVEL,SCLEVEL2,SCSTAT,SCXSITE,SCLOCAL,SCTMCNT,SCDISPSV,SCTYPE,SCSKIP,SCOTHTM
SET SCDISP=0
SET SCTMCNT=0
SET SCDISPSV=0
SET SCSKIP=0
SET SCOTHTM=0
;Teams from web service call
SET SCLEVEL=""
FOR SET SCLEVEL=$ORDER(SCTEAMS(SCLEVEL)) QUIT:SCLEVEL="" DO
. SET SCDISP=SCDISP+1
. SET SCDISPLY(SCDISP)=""
. ;Check for local site
. SET SCXSITE=$TR($PIECE($GET(SCTEAMS(SCLEVEL,"STATION")),"(",2),"#)","")
. SET SCLOCAL=$SELECT(SCSITE=SCXSITE:1,1:0)
. IF SCLOCAL DO
. . SET SCDISP=SCDISP+1
. . SET SCDISPLY(SCDISP)="LOCAL - "_$GET(SCTEAMS(SCLEVEL,"STATION"))
. . ;Inpatient providers
. . IF $GET(SCINPAT("ATT NAME"))'="" DO
. . . SET SCDISP=SCDISP+1
. . . SET SCSKIP=1
. . . SET SCDISPLY(SCDISP)=" Inpatient Attending: "_$GET(SCINPAT("ATT NAME"))_$$FMTPHPG("I","ATT",0)
. . IF $GET(SCINPAT("PROV NAME"))'="" DO
. . . SET SCDISP=SCDISP+1
. . . SET SCSKIP=1
. . . SET SCDISPLY(SCDISP)=" Inpatient Provider: "_$GET(SCINPAT("PROV NAME"))_$$FMTPHPG("I","PROV",0)
. ELSE DO
. . SET SCDISP=SCDISP+1
. . SET SCDISPLY(SCDISP)="REMOTE - "_$GET(SCTEAMS(SCLEVEL,"STATION"))
. IF SCLOCAL,SCSKIP DO
. . SET SCDISP=SCDISP+1
. . SET SCDISPLY(SCDISP)=""
. ;
. ;PACT
. IF '$DATA(SCTEAMS(SCLEVEL,2)) DO
. . IF SCLOCAL DO
. . . SET SCDISP=SCDISP+1
. . . SET SCDISPSV=SCDISP
. . . SET SCDISPLY(SCDISP)=" PACT: No Local PACT Assigned."
. SET SCY=""
. FOR SET SCY=$ORDER(SCTEAMS(SCLEVEL,2,SCY)) QUIT:SCY="" DO
. . IF $GET(SCTEAMS(SCLEVEL,2,SCY,"PACT"))'="" DO
. . . SET SCTMCNT=SCTMCNT+1
. . . SET SCSTAT=$GET(SCTEAMS(SCLEVEL,2,SCY,"STATUS"))
. . . SET SCSTAT=$SELECT(SCSTAT="Pending":"PENDING: ",1:"")
. . . SET SCDISP=SCDISP+1
. . . SET SCDISPLY(SCDISP)=" PACT: "_SCSTAT_$GET(SCTEAMS(SCLEVEL,2,SCY,"PACT"))
. . . SET SCDISP=SCDISP+1
. . . IF $GET(SCTEAMS(SCLEVEL,2,SCY,"PCP NAME"))'="" DO
. . . . SET SCDISPLY(SCDISP)=" Primary Care Provider: "_$GET(SCTEAMS(SCLEVEL,2,SCY,"PCP NAME"))_$$FMTPHPG("P","PCP",2)
. . . ELSE DO
. . . . SET SCDISPLY(SCDISP)=" Primary Care Provider: Vacant"
. . . IF $GET(SCTEAMS(SCLEVEL,2,SCY,"ASSOC NAME"))'="" DO
. . . . SET SCDISP=SCDISP+1
. . . . SET SCDISPLY(SCDISP)=" Associate Provider: "_$GET(SCTEAMS(SCLEVEL,2,SCY,"ASSOC NAME"))_$$FMTPHPG("P","ASSOC",2)
. . . SET SCDISP=SCDISP+1
. . . IF $GET(SCTEAMS(SCLEVEL,2,SCY,"APOC NAME"))'="" DO
. . . . SET SCDISPLY(SCDISP)=" Administrative POC: "_$GET(SCTEAMS(SCLEVEL,2,SCY,"APOC ROLE"))_" || "_$GET(SCTEAMS(SCLEVEL,2,SCY,"APOC NAME"))_$$FMTPHPG("P","APOC",2)
. . . ELSE DO
. . . . SET SCDISPLY(SCDISP)=" Administrative POC: Vacant"
. . . SET SCDISP=SCDISP+1
. . . IF $GET(SCTEAMS(SCLEVEL,2,SCY,"CPOC NAME"))'="" DO
. . . . SET SCDISPLY(SCDISP)=" Clinical POC: "_$GET(SCTEAMS(SCLEVEL,2,SCY,"CPOC ROLE"))_" || "_$GET(SCTEAMS(SCLEVEL,2,SCY,"CPOC NAME"))_$$FMTPHPG("P","CPOC",2)
. . . ELSE DO
. . . . SET SCDISPLY(SCDISP)=" Clinical POC: Vacant"
. . ELSE DO ;No Local PACT Assigned
. . . IF SCLOCAL DO
. . . . SET SCDISP=SCDISP+1
. . . . SET SCDISPSV=SCDISP
. . . . SET SCDISPLY(SCDISP)=" PACT: No Local PACT Assigned."
. ;
. ; Mental Health
. SET SCY=""
. FOR SET SCY=$ORDER(SCTEAMS(SCLEVEL,4,SCY)) QUIT:SCY="" DO
. . IF $GET(SCTEAMS(SCLEVEL,4,SCY,"SP TEAM"))'="" DO
. . . SET SCDISP=SCDISP+1
. . . SET SCDISPLY(SCDISP)=""
. . . SET SCDISP=SCDISP+1
. . . SET SCDISPLY(SCDISP)=" MH: "_$GET(SCTEAMS(SCLEVEL,4,SCY,"SP TEAM"))
. . . SET SCZ=0
. . . FOR SET SCZ=$ORDER(SCTEAMS(SCLEVEL,4,SCY,SCZ)) QUIT:'SCZ DO
. . . . SET SCDISP=SCDISP+1
. . . . SET SCDISPLY(SCDISP)=" "_$GET(SCTEAMS(SCLEVEL,4,SCY,SCZ,"SP ROLE"))_" || "_$GET(SCTEAMS(SCLEVEL,4,SCY,SCZ,"SP NAME"))_$$FMTPHPG("S","SP",4)
. . . SET:SCLOCAL SCOTHTM=1
. ;
. ; OEF/OIF/OND
. SET SCY=""
. FOR SET SCY=$ORDER(SCTEAMS(SCLEVEL,"OEF",SCY)) QUIT:SCY="" DO
. . IF ($GET(SCTEAMS(SCLEVEL,"OEF",SCY,"OEF TEAM"))'="")!($GET(SCTEAMS(SCLEVEL,"OEF",SCY,"OEF MGR"))'="") DO
. . . SET SCDISP=SCDISP+1
. . . SET SCDISPLY(SCDISP)=""
. . . SET SCDISP=SCDISP+1
. . . SET SCDISPLY(SCDISP)=" OEF/OIF/OND: "_$GET(SCTEAMS(SCLEVEL,"OEF",SCY,"OEF TEAM"))
. . . SET SCDISP=SCDISP+1
. . . SET SCDISPLY(SCDISP)=" LEAD COORDINATOR: "_$GET(SCTEAMS(SCLEVEL,"OEF",SCY,"OEF MGR"))_$$FMTPHPG("O","OEF","OEF")
. . . SET:SCLOCAL SCOTHTM=1
. ;
. ; Specialty
. SET SCX=""
. FOR SET SCX=$ORDER(SCTEAMS(SCLEVEL,SCX)) QUIT:'+SCX DO
. . QUIT:SCX=4 ;MH
. . QUIT:SCX=2 ;PC
. . QUIT:SCX=10 ;OEF
. . SET SCY=0
. . FOR SET SCY=$ORDER(SCTEAMS(SCLEVEL,SCX,SCY)) QUIT:'+SCY DO
. . . IF ($GET(SCTEAMS(SCLEVEL,SCX,SCY,"SP TEAM"))'="")!($GET(SCTEAMS(SCLEVEL,SCX,SCY,"SP ROLE"))'="") DO
. . . . SET SCDISP=SCDISP+1
. . . . SET SCDISPLY(SCDISP)=""
. . . . SET SCDISP=SCDISP+1
. . . SET SCDISPLY(SCDISP)=" SP: "_$GET(SCTEAMS(SCLEVEL,SCX,SCY,"SP TEAM"))
. . . SET SCZ=0
. . . FOR SET SCZ=$ORDER(SCTEAMS(SCLEVEL,SCX,SCY,SCZ)) QUIT:'SCZ DO
. . . . SET SCDISP=SCDISP+1
. . . . SET SCDISPLY(SCDISP)=" "_$GET(SCTEAMS(SCLEVEL,SCX,SCY,SCZ,"SP ROLE"))_" || "_$GET(SCTEAMS(SCLEVEL,SCX,SCY,SCZ,"SP NAME"))_$$FMTPHPG("S","SP",SCX)
. . . SET:SCLOCAL SCOTHTM=1
;Check if PACTs assigned
IF 'SCTMCNT,SCDISPSV DO
. SET:'SCOTHTM SCDISPLY(SCDISPSV-1)=""
. SET SCDISPLY(SCDISPSV)=" No PACT assigned at any VA location."
IF '$DATA(SCTEAMS) DO
. SET SCDISP=SCDISP+1
. SET SCDISPLY(SCDISP)=""
. SET SCDISP=SCDISP+1
. SET SCDISPLY(SCDISP)=" No PACT assigned at any VA location."
; Non-VA Providers
QUIT:'$DATA(SCNVA)
SET SCDISP=SCDISP+1
SET SCDISPLY(SCDISP)=""
SET SCLEVEL=""
FOR SET SCLEVEL=$ORDER(SCNVA(SCLEVEL)) QUIT:SCLEVEL="" DO
. SET SCDISP=SCDISP+1
. SET SCDISPLY(SCDISP)="Non-VA: "_$GET(SCNVA(SCLEVEL,"ROLE"))_" || "_$GET(SCNVA(SCLEVEL,"NAME"))_$$FMTPHPG("N","N",0)
;
QUIT
;
FMTPHPG(SCTYPE,SCPREFIX,SCTEAMID) ;Format Phone and Pager #
;Inputs: SCTYPE - Team Type - I=Inpatient, P=Primary Care, O=OEF/OIF, S=Specialty & MH, N=Non-VA
; SCPREFIX - Value of Prefix
; SCTEAMID - Value of team ID
;Returns: Phone and Pager string
;
QUIT:$GET(SCTYPE)="" -1
QUIT:$GET(SCPREFIX)="" -2
QUIT:$GET(SCTEAMID)="" -3
NEW SCPPSTR
SET SCPPSTR=""
; Inpatient
IF SCTYPE="I" DO
. SET SCPPSTR=$SELECT($GET(SCINPAT(SCPREFIX_" PHONE"))="":"",1:" || PHONE:"_SCINPAT(SCPREFIX_" PHONE"))
. SET SCPPSTR=SCPPSTR_$S($GET(SCINPAT(SCPREFIX_" PAGER"))="":"",1:" || PAGER:"_SCINPAT(SCPREFIX_" PAGER"))
; Primary Care
IF SCTYPE="P" DO
. SET SCPPSTR=$SELECT($GET(SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCPREFIX_" PHONE"))="":"",1:" || PHONE:"_SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCPREFIX_" PHONE"))
. SET SCPPSTR=SCPPSTR_$SELECT($GET(SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCPREFIX_" PAGER"))="":"",1:" || PAGER:"_SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCPREFIX_" PAGER"))
; Specialty & MH
IF SCTYPE="S" DO
. SET SCPPSTR=$SELECT($GET(SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCZ,SCPREFIX_" PHONE"))="":"",1:" || PHONE:"_SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCZ,SCPREFIX_" PHONE"))
. SET SCPPSTR=SCPPSTR_$S($GET(SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCZ,SCPREFIX_" PAGER"))="":"",1:" || PAGER:"_SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCZ,SCPREFIX_" PAGER"))
; OEF/OIF
IF SCTYPE="O" DO
. SET SCPPSTR=$SELECT($GET(SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCPREFIX_" PHONE"))="":"",1:" || PHONE:"_SCTEAMS(SCLEVEL,SCPREFIX,SCY,SCPREFIX_" PHONE"))
. SET SCPPSTR=SCPPSTR_$S($GET(SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCPREFIX_" PAGER"))="":"",1:" || PAGER:"_SCTEAMS(SCLEVEL,SCPREFIX,SCY,SCPREFIX_" PAGER"))
; Non-VA
IF SCTYPE="N" DO
. SET SCPPSTR=$SELECT($GET(SCNVA(SCLEVEL,"PHONE"))="":"",1:" || PHONE:"_SCNVA(SCLEVEL,"PHONE"))
. SET SCPPSTR=SCPPSTR_$SELECT($GET(SCNVA(SCLEVEL,"CITY"))="":"",1:" || CITY: "_SCNVA(SCLEVEL,"CITY"))
. SET SCPPSTR=SCPPSTR_$SELECT($GET(SCNVA(SCLEVEL,"STATE"))="":"",1:" || STATE: "_SCNVA(SCLEVEL,"STATE"))
;
QUIT SCPPSTR
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCWS1 13492 printed Apr 09, 2024@21:57:22 Page 2
SCMCWS1 ;ALB/ART - PCMM Web-Call Patient Summary Web Service ;02/06/2015
+1 ;;5.3;Scheduling;**603**;Aug 13, 1993;Build 79
+2 ;
+3 QUIT
+4 ;
+5 ;Public, Supported ICRs
+6 ; #2053 - Data Base Server API: Editing Utilities (DIE)
+7 ; #2056 - Data Base Server API: Data Retriever Utilities (DIQ)
+8 ; #4440 - DBIA4440 (XUPROD)
+9 ; #5421 - XOBWLIB - Public APIs for HWSC
+10 ; #10035 - PATIENT FILE
+11 ; #10060 - NEW PERSON FILE
+12 ; #10103 - XLFDT - Supported APIs for date & time
+13 ; #10112 - VASITE - Supported APIs for site info
+14 ;
PCDETAIL(SCDISPLY,SCDFN) ;Call PCMM/R Web Service
+1 ;Inputs: SCDISPLY - Array for team assignment info - passed by reference
+2 ; SCDFN - Patient DFN
+3 ;Output: populated SCDISPLY
+4 ; ICR #6027 - SCMC PCMM/R GET PRIMARY CARE DETAILS
+5 ;
+6 NEW SCSERVER,SCSERVC,SCLIST,SCSRVRKY,SCRC
+7 NEW SCSTAT,SCEOF,SCREADR,SCCNT,SCARRAY,SCVALUE,SCNODE,SCROW
+8 NEW SCREST,SCGETRC,SCERR
+9 NEW SCTEAMS,SCINPAT,SCNVA,SCBLOCK,SCTMLVL,SCPCLVL,SCNVALVL,SCMHLVL,SCOELVL,SCSPLVL,SCSPTYPE,SCSPMBR
+10 NEW SCDATA,SCX,SCY
+11 ;
+12 IF $$PROD^XUPROD
Begin DoDot:1
+13 SET SCDATA("serverNameKey")="PCMMR SERVER"
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 SET SCDATA("serverNameKey")="PCMMR TEST SERVER"
End DoDot:1
+16 SET SCDATA("webServiceName")="PCMM-R GET PC INFO REST"
+17 ;
+18 ; Web service setup
+19 SET SCRC=+$$SETUP^SCMCWSUT(.SCDATA)
+20 IF SCRC=0
Begin DoDot:1
+21 SET SCDISPLY(1)=$PIECE(SCRC,U,2)
End DoDot:1
QUIT
+22 ;
+23 ; Get client REST request object
+24 SET SCDATA("restObject")=$$GETREST^XOBWLIB(SCDATA("webServiceName"),SCDATA("serverName"))
+25 ;
+26 ; Get Local Site ID
+27 ;Institution file pointer^Institution name^station number with suffix
+28 SET SCDATA("site")=$PIECE($$SITE^VASITE(),U,3)
+29 ;
+30 ; Set PCMM/R web service parameters
+31 SET SCDATA("webServiceParameters")="/"_SCDATA("site")_"/"_SCDFN_".xml"
+32 ;
+33 ; Retrieve the resource; execute HTTP GET method
+34 SET SCGETRC=$$GET^XOBWLIB(SCDATA("restObject"),SCDATA("webServiceParameters"),.SCERR,0)
+35 IF 'SCGETRC
Begin DoDot:1
+36 SET SCRC=$$GET1^DIQ(404.41,SCDFN_",",.07,"","SCDISPLY")
+37 IF $GET(SCDISPLY(1))=""
Begin DoDot:2
+38 SET SCDISPLY(1)="PCMM is unavailable."
End DoDot:2
End DoDot:1
QUIT
+39 ;
+40 ; Parse the XML stream
+41 SET SCSTAT=##class(%XML.TextReader).ParseStream(SCDATA("restObject").HttpResponse.Data,.SCREADR)
+42 ;
+43 ; Check XML parse error
+44 IF 'SCSTAT
Begin DoDot:1
+45 SET SCDISPLY(1)=">>> ERROR reading XML <<<"
+46 SET SCDISPLY(2)=" Invalid XML Format"
End DoDot:1
QUIT
+47 ;
+48 ; Process XML
+49 SET SCTMLVL=0
+50 SET SCPCLVL=0
+51 SET SCNVALVL=0
+52 SET SCMHLVL=0
+53 SET SCOELVL=0
+54 SET SCSPLVL=0
+55 SET SCSPTYPE=0
+56 SET SCSPMBR=0
+57 SET SCCNT=0
+58 SET SCBLOCK=0
+59 SET SCEOF=0
+60 FOR
if SCEOF!SCREADR.EOF!'SCREADR.Read()
QUIT
Begin DoDot:1
+61 ; Get element value
+62 IF (SCREADR.NodeType="chars")
Begin DoDot:2
+63 SET SCNODE=SCREADR.Path
+64 SET SCVALUE=SCREADR.Value
+65 DO PARSEXML^SCMCWS1A(SCNODE,SCVALUE,.SCTEAMS,.SCNVA,.SCTMLVL,.SCPCLVL,.SCNVALVL,.SCMHLVL,.SCOELVL,.SCSPLVL,.SCSPTYPE,.SCSPMBR,.SCBLOCK,.SCEOF)
End DoDot:2
+66 ; Check for last closing tag
+67 IF (SCREADR.NodeType="endelement")&(SCREADR.LocalName="PatientSummary")
Begin DoDot:2
+68 SET SCEOF=1
End DoDot:2
End DoDot:1
+69 ;
+70 ; Get Ipatient Data
+71 DO GETINPAT(SCDFN,.SCINPAT)
+72 ;
+73 ; Build Display Array
+74 IF 'SCBLOCK
Begin DoDot:1
+75 DO BLDISPLY(.SCTEAMS,.SCINPAT,.SCNVA,.SCDISPLY,SCDATA("site"))
End DoDot:1
+76 IF '$TEST
Begin DoDot:1
+77 DO BLDBLOCK(.SCTEAMS,.SCINPAT,.SCDISPLY)
End DoDot:1
+78 ;
+79 ;Save display array in OutPatient Profile
+80 SET SCDISPLY(1)="ATTENTION: PCMM is unavailable, data is current as of: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)
+81 DO WP^DIE(404.41,SCDFN_",",.07,"K","SCDISPLY")
+82 SET SCDISPLY(1)=""
+83 ;
+84 QUIT
+85 ;
+86 ;
GETINPAT(SCDFN,SCINPAT) ;Build an array of local attending and inpatient providers
+1 ;Inputs: SCDFN - patient DFN
+2 ; SCINPAT - inpatient provider array - by reference
+3 ;Output: Populated inpatient provider array
+4 ;
+5 NEW SCATT,SCPROV
+6 ;If patient is assigned to a ward
+7 IF $$GET1^DIQ(2,SCDFN_",",.1)'=""
Begin DoDot:1
+8 SET SCATT=$$GET1^DIQ(2,SCDFN_",",.1041,"I")
+9 SET SCPROV=$$GET1^DIQ(2,SCDFN_",",.104,"I")
+10 ;populate array from New Person File
+11 IF +SCATT
Begin DoDot:2
+12 SET SCINPAT("ATT NAME")=$$GET1^DIQ(200,+SCATT_",",.01)
+13 SET SCINPAT("ATT PHONE")=$$GET1^DIQ(200,+SCATT_",",.132)
+14 SET SCINPAT("ATT PAGER")=$$GET1^DIQ(200,+SCATT_",",.138)
End DoDot:2
+15 IF +SCPROV
Begin DoDot:2
+16 SET SCINPAT("PROV NAME")=$$GET1^DIQ(200,+SCPROV_",",.01)
+17 SET SCINPAT("PROV PHONE")=$$GET1^DIQ(200,+SCPROV_",",.132)
+18 SET SCINPAT("PROV PAGER")=$$GET1^DIQ(200,+SCPROV_",",.138)
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
BLDBLOCK(SCTEAMS,SCINPAT,SCDISPLY) ; Build the Display Array
+1 ;Inputs: SCTEAMS - Teams array - by reference
+2 ; SCINPAT - inpatient array - by reference
+3 ; SCDISPLY - Display array - by reference
+4 ;Output: Populated Display Array
+5 ;
+6 NEW SCDISP,SCSKIP,SCI
+7 ;
+8 SET SCDISP=1
+9 SET SCSKIP=0
+10 SET SCDISPLY(SCDISP)=""
+11 ;Inpatient providers
+12 IF $GET(SCINPAT("ATT NAME"))'=""
Begin DoDot:1
+13 SET SCDISP=SCDISP+1
+14 SET SCSKIP=1
+15 SET SCDISPLY(SCDISP)=" Inpatient Attending: "_$GET(SCINPAT("ATT NAME"))_$$FMTPHPG("I","ATT",0)
End DoDot:1
+16 IF $GET(SCINPAT("PROV NAME"))'=""
Begin DoDot:1
+17 SET SCDISP=SCDISP+1
+18 SET SCSKIP=1
+19 SET SCDISPLY(SCDISP)=" Inpatient Provider: "_$GET(SCINPAT("PROV NAME"))_$$FMTPHPG("I","PROV",0)
End DoDot:1
+20 IF SCSKIP
Begin DoDot:1
+21 SET SCDISP=SCDISP+1
+22 SET SCDISPLY(SCDISP)=""
End DoDot:1
+23 ;
+24 FOR SCI=1:1
if '$DATA(SCTEAMS(SCI))
QUIT
Begin DoDot:1
+25 SET SCDISP=SCDISP+1
+26 SET SCDISPLY(SCDISP)=SCTEAMS(SCI)
End DoDot:1
+27 ;
+28 QUIT
+29 ;
BLDISPLY(SCTEAMS,SCINPAT,SCNVA,SCDISPLY,SCSITE) ; Build the Display Array
+1 ;Inputs: SCTEAMS - Teams array - by reference
+2 ; SCINPAT - inpatient array - by reference
+3 ; SCNVA - nonVA array - by reference
+4 ; SCDISPLY - Display array - by reference
+5 ; SCSITE - Site Number
+6 ;Output: Populated Display Array
+7 ;
+8 NEW SCDISP,SCX,SCY,SCZ,SCLEVEL,SCLEVEL2,SCSTAT,SCXSITE,SCLOCAL,SCTMCNT,SCDISPSV,SCTYPE,SCSKIP,SCOTHTM
+9 SET SCDISP=0
+10 SET SCTMCNT=0
+11 SET SCDISPSV=0
+12 SET SCSKIP=0
+13 SET SCOTHTM=0
+14 ;Teams from web service call
+15 SET SCLEVEL=""
+16 FOR
SET SCLEVEL=$ORDER(SCTEAMS(SCLEVEL))
if SCLEVEL=""
QUIT
Begin DoDot:1
+17 SET SCDISP=SCDISP+1
+18 SET SCDISPLY(SCDISP)=""
+19 ;Check for local site
+20 SET SCXSITE=$TRANSLATE($PIECE($GET(SCTEAMS(SCLEVEL,"STATION")),"(",2),"#)","")
+21 SET SCLOCAL=$SELECT(SCSITE=SCXSITE:1,1:0)
+22 IF SCLOCAL
Begin DoDot:2
+23 SET SCDISP=SCDISP+1
+24 SET SCDISPLY(SCDISP)="LOCAL - "_$GET(SCTEAMS(SCLEVEL,"STATION"))
+25 ;Inpatient providers
+26 IF $GET(SCINPAT("ATT NAME"))'=""
Begin DoDot:3
+27 SET SCDISP=SCDISP+1
+28 SET SCSKIP=1
+29 SET SCDISPLY(SCDISP)=" Inpatient Attending: "_$GET(SCINPAT("ATT NAME"))_$$FMTPHPG("I","ATT",0)
End DoDot:3
+30 IF $GET(SCINPAT("PROV NAME"))'=""
Begin DoDot:3
+31 SET SCDISP=SCDISP+1
+32 SET SCSKIP=1
+33 SET SCDISPLY(SCDISP)=" Inpatient Provider: "_$GET(SCINPAT("PROV NAME"))_$$FMTPHPG("I","PROV",0)
End DoDot:3
End DoDot:2
+34 IF '$TEST
Begin DoDot:2
+35 SET SCDISP=SCDISP+1
+36 SET SCDISPLY(SCDISP)="REMOTE - "_$GET(SCTEAMS(SCLEVEL,"STATION"))
End DoDot:2
+37 IF SCLOCAL
IF SCSKIP
Begin DoDot:2
+38 SET SCDISP=SCDISP+1
+39 SET SCDISPLY(SCDISP)=""
End DoDot:2
+40 ;
+41 ;PACT
+42 IF '$DATA(SCTEAMS(SCLEVEL,2))
Begin DoDot:2
+43 IF SCLOCAL
Begin DoDot:3
+44 SET SCDISP=SCDISP+1
+45 SET SCDISPSV=SCDISP
+46 SET SCDISPLY(SCDISP)=" PACT: No Local PACT Assigned."
End DoDot:3
End DoDot:2
+47 SET SCY=""
+48 FOR
SET SCY=$ORDER(SCTEAMS(SCLEVEL,2,SCY))
if SCY=""
QUIT
Begin DoDot:2
+49 IF $GET(SCTEAMS(SCLEVEL,2,SCY,"PACT"))'=""
Begin DoDot:3
+50 SET SCTMCNT=SCTMCNT+1
+51 SET SCSTAT=$GET(SCTEAMS(SCLEVEL,2,SCY,"STATUS"))
+52 SET SCSTAT=$SELECT(SCSTAT="Pending":"PENDING: ",1:"")
+53 SET SCDISP=SCDISP+1
+54 SET SCDISPLY(SCDISP)=" PACT: "_SCSTAT_$GET(SCTEAMS(SCLEVEL,2,SCY,"PACT"))
+55 SET SCDISP=SCDISP+1
+56 IF $GET(SCTEAMS(SCLEVEL,2,SCY,"PCP NAME"))'=""
Begin DoDot:4
+57 SET SCDISPLY(SCDISP)=" Primary Care Provider: "_$GET(SCTEAMS(SCLEVEL,2,SCY,"PCP NAME"))_$$FMTPHPG("P","PCP",2)
End DoDot:4
+58 IF '$TEST
Begin DoDot:4
+59 SET SCDISPLY(SCDISP)=" Primary Care Provider: Vacant"
End DoDot:4
+60 IF $GET(SCTEAMS(SCLEVEL,2,SCY,"ASSOC NAME"))'=""
Begin DoDot:4
+61 SET SCDISP=SCDISP+1
+62 SET SCDISPLY(SCDISP)=" Associate Provider: "_$GET(SCTEAMS(SCLEVEL,2,SCY,"ASSOC NAME"))_$$FMTPHPG("P","ASSOC",2)
End DoDot:4
+63 SET SCDISP=SCDISP+1
+64 IF $GET(SCTEAMS(SCLEVEL,2,SCY,"APOC NAME"))'=""
Begin DoDot:4
+65 SET SCDISPLY(SCDISP)=" Administrative POC: "_$GET(SCTEAMS(SCLEVEL,2,SCY,"APOC ROLE"))_" || "_$GET(SCTEAMS(SCLEVEL,2,SCY,"APOC NAME"))_$$FMTPHPG("P","APOC",2)
End DoDot:4
+66 IF '$TEST
Begin DoDot:4
+67 SET SCDISPLY(SCDISP)=" Administrative POC: Vacant"
End DoDot:4
+68 SET SCDISP=SCDISP+1
+69 IF $GET(SCTEAMS(SCLEVEL,2,SCY,"CPOC NAME"))'=""
Begin DoDot:4
+70 SET SCDISPLY(SCDISP)=" Clinical POC: "_$GET(SCTEAMS(SCLEVEL,2,SCY,"CPOC ROLE"))_" || "_$GET(SCTEAMS(SCLEVEL,2,SCY,"CPOC NAME"))_$$FMTPHPG("P","CPOC",2)
End DoDot:4
+71 IF '$TEST
Begin DoDot:4
+72 SET SCDISPLY(SCDISP)=" Clinical POC: Vacant"
End DoDot:4
End DoDot:3
+73 ;No Local PACT Assigned
IF '$TEST
Begin DoDot:3
+74 IF SCLOCAL
Begin DoDot:4
+75 SET SCDISP=SCDISP+1
+76 SET SCDISPSV=SCDISP
+77 SET SCDISPLY(SCDISP)=" PACT: No Local PACT Assigned."
End DoDot:4
End DoDot:3
End DoDot:2
+78 ;
+79 ; Mental Health
+80 SET SCY=""
+81 FOR
SET SCY=$ORDER(SCTEAMS(SCLEVEL,4,SCY))
if SCY=""
QUIT
Begin DoDot:2
+82 IF $GET(SCTEAMS(SCLEVEL,4,SCY,"SP TEAM"))'=""
Begin DoDot:3
+83 SET SCDISP=SCDISP+1
+84 SET SCDISPLY(SCDISP)=""
+85 SET SCDISP=SCDISP+1
+86 SET SCDISPLY(SCDISP)=" MH: "_$GET(SCTEAMS(SCLEVEL,4,SCY,"SP TEAM"))
+87 SET SCZ=0
+88 FOR
SET SCZ=$ORDER(SCTEAMS(SCLEVEL,4,SCY,SCZ))
if 'SCZ
QUIT
Begin DoDot:4
+89 SET SCDISP=SCDISP+1
+90 SET SCDISPLY(SCDISP)=" "_$GET(SCTEAMS(SCLEVEL,4,SCY,SCZ,"SP ROLE"))_" || "_$GET(SCTEAMS(SCLEVEL,4,SCY,SCZ,"SP NAME"))_$$FMTPHPG("S","SP",4)
End DoDot:4
+91 if SCLOCAL
SET SCOTHTM=1
End DoDot:3
End DoDot:2
+92 ;
+93 ; OEF/OIF/OND
+94 SET SCY=""
+95 FOR
SET SCY=$ORDER(SCTEAMS(SCLEVEL,"OEF",SCY))
if SCY=""
QUIT
Begin DoDot:2
+96 IF ($GET(SCTEAMS(SCLEVEL,"OEF",SCY,"OEF TEAM"))'="")!($GET(SCTEAMS(SCLEVEL,"OEF",SCY,"OEF MGR"))'="")
Begin DoDot:3
+97 SET SCDISP=SCDISP+1
+98 SET SCDISPLY(SCDISP)=""
+99 SET SCDISP=SCDISP+1
+100 SET SCDISPLY(SCDISP)=" OEF/OIF/OND: "_$GET(SCTEAMS(SCLEVEL,"OEF",SCY,"OEF TEAM"))
+101 SET SCDISP=SCDISP+1
+102 SET SCDISPLY(SCDISP)=" LEAD COORDINATOR: "_$GET(SCTEAMS(SCLEVEL,"OEF",SCY,"OEF MGR"))_$$FMTPHPG("O","OEF","OEF")
+103 if SCLOCAL
SET SCOTHTM=1
End DoDot:3
End DoDot:2
+104 ;
+105 ; Specialty
+106 SET SCX=""
+107 FOR
SET SCX=$ORDER(SCTEAMS(SCLEVEL,SCX))
if '+SCX
QUIT
Begin DoDot:2
+108 ;MH
if SCX=4
QUIT
+109 ;PC
if SCX=2
QUIT
+110 ;OEF
if SCX=10
QUIT
+111 SET SCY=0
+112 FOR
SET SCY=$ORDER(SCTEAMS(SCLEVEL,SCX,SCY))
if '+SCY
QUIT
Begin DoDot:3
+113 IF ($GET(SCTEAMS(SCLEVEL,SCX,SCY,"SP TEAM"))'="")!($GET(SCTEAMS(SCLEVEL,SCX,SCY,"SP ROLE"))'="")
Begin DoDot:4
+114 SET SCDISP=SCDISP+1
+115 SET SCDISPLY(SCDISP)=""
+116 SET SCDISP=SCDISP+1
End DoDot:4
+117 SET SCDISPLY(SCDISP)=" SP: "_$GET(SCTEAMS(SCLEVEL,SCX,SCY,"SP TEAM"))
+118 SET SCZ=0
+119 FOR
SET SCZ=$ORDER(SCTEAMS(SCLEVEL,SCX,SCY,SCZ))
if 'SCZ
QUIT
Begin DoDot:4
+120 SET SCDISP=SCDISP+1
+121 SET SCDISPLY(SCDISP)=" "_$GET(SCTEAMS(SCLEVEL,SCX,SCY,SCZ,"SP ROLE"))_" || "_$GET(SCTEAMS(SCLEVEL,SCX,SCY,SCZ,"SP NAME"))_$$FMTPHPG("S","SP",SCX)
End DoDot:4
+122 if SCLOCAL
SET SCOTHTM=1
End DoDot:3
End DoDot:2
End DoDot:1
+123 ;Check if PACTs assigned
+124 IF 'SCTMCNT
IF SCDISPSV
Begin DoDot:1
+125 if 'SCOTHTM
SET SCDISPLY(SCDISPSV-1)=""
+126 SET SCDISPLY(SCDISPSV)=" No PACT assigned at any VA location."
End DoDot:1
+127 IF '$DATA(SCTEAMS)
Begin DoDot:1
+128 SET SCDISP=SCDISP+1
+129 SET SCDISPLY(SCDISP)=""
+130 SET SCDISP=SCDISP+1
+131 SET SCDISPLY(SCDISP)=" No PACT assigned at any VA location."
End DoDot:1
+132 ; Non-VA Providers
+133 if '$DATA(SCNVA)
QUIT
+134 SET SCDISP=SCDISP+1
+135 SET SCDISPLY(SCDISP)=""
+136 SET SCLEVEL=""
+137 FOR
SET SCLEVEL=$ORDER(SCNVA(SCLEVEL))
if SCLEVEL=""
QUIT
Begin DoDot:1
+138 SET SCDISP=SCDISP+1
+139 SET SCDISPLY(SCDISP)="Non-VA: "_$GET(SCNVA(SCLEVEL,"ROLE"))_" || "_$GET(SCNVA(SCLEVEL,"NAME"))_$$FMTPHPG("N","N",0)
End DoDot:1
+140 ;
+141 QUIT
+142 ;
FMTPHPG(SCTYPE,SCPREFIX,SCTEAMID) ;Format Phone and Pager #
+1 ;Inputs: SCTYPE - Team Type - I=Inpatient, P=Primary Care, O=OEF/OIF, S=Specialty & MH, N=Non-VA
+2 ; SCPREFIX - Value of Prefix
+3 ; SCTEAMID - Value of team ID
+4 ;Returns: Phone and Pager string
+5 ;
+6 if $GET(SCTYPE)=""
QUIT -1
+7 if $GET(SCPREFIX)=""
QUIT -2
+8 if $GET(SCTEAMID)=""
QUIT -3
+9 NEW SCPPSTR
+10 SET SCPPSTR=""
+11 ; Inpatient
+12 IF SCTYPE="I"
Begin DoDot:1
+13 SET SCPPSTR=$SELECT($GET(SCINPAT(SCPREFIX_" PHONE"))="":"",1:" || PHONE:"_SCINPAT(SCPREFIX_" PHONE"))
+14 SET SCPPSTR=SCPPSTR_$SELECT($GET(SCINPAT(SCPREFIX_" PAGER"))="":"",1:" || PAGER:"_SCINPAT(SCPREFIX_" PAGER"))
End DoDot:1
+15 ; Primary Care
+16 IF SCTYPE="P"
Begin DoDot:1
+17 SET SCPPSTR=$SELECT($GET(SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCPREFIX_" PHONE"))="":"",1:" || PHONE:"_SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCPREFIX_" PHONE"))
+18 SET SCPPSTR=SCPPSTR_$SELECT($GET(SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCPREFIX_" PAGER"))="":"",1:" || PAGER:"_SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCPREFIX_" PAGER"))
End DoDot:1
+19 ; Specialty & MH
+20 IF SCTYPE="S"
Begin DoDot:1
+21 SET SCPPSTR=$SELECT($GET(SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCZ,SCPREFIX_" PHONE"))="":"",1:" || PHONE:"_SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCZ,SCPREFIX_" PHONE"))
+22 SET SCPPSTR=SCPPSTR_$SELECT($GET(SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCZ,SCPREFIX_" PAGER"))="":"",1:" || PAGER:"_SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCZ,SCPREFIX_" PAGER"))
End DoDot:1
+23 ; OEF/OIF
+24 IF SCTYPE="O"
Begin DoDot:1
+25 SET SCPPSTR=$SELECT($GET(SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCPREFIX_" PHONE"))="":"",1:" || PHONE:"_SCTEAMS(SCLEVEL,SCPREFIX,SCY,SCPREFIX_" PHONE"))
+26 SET SCPPSTR=SCPPSTR_$SELECT($GET(SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCPREFIX_" PAGER"))="":"",1:" || PAGER:"_SCTEAMS(SCLEVEL,SCPREFIX,SCY,SCPREFIX_" PAGER"))
End DoDot:1
+27 ; Non-VA
+28 IF SCTYPE="N"
Begin DoDot:1
+29 SET SCPPSTR=$SELECT($GET(SCNVA(SCLEVEL,"PHONE"))="":"",1:" || PHONE:"_SCNVA(SCLEVEL,"PHONE"))
+30 SET SCPPSTR=SCPPSTR_$SELECT($GET(SCNVA(SCLEVEL,"CITY"))="":"",1:" || CITY: "_SCNVA(SCLEVEL,"CITY"))
+31 SET SCPPSTR=SCPPSTR_$SELECT($GET(SCNVA(SCLEVEL,"STATE"))="":"",1:" || STATE: "_SCNVA(SCLEVEL,"STATE"))
End DoDot:1
+32 ;
+33 QUIT SCPPSTR
+34 ;
