- SCMCWS1 ;ALB/ART - PCMM Web-Call Patient Summary Web Service ;02/06/2015
- ;;5.3;Scheduling;**603,854**;Aug 13, 1993;Build 4
- ;
- 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
- ; #20150204-01 SACC EXEMPTION for Vendor specific code is restricted.
- ;
- 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,SCGFICN,SCFALSE,SCVCNT,SCDFNSAVE
- ;
- S SCVCNT=0
- 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"
- ;
- I SCVCNT<1,(SCVCNT>1) D SCDFN
- ;
- SCDICN ;START ICN FIND RTW SD*5.3*854
- Q:SCVCNT>1
- I $D(SCFALSE),SCVCNT<2 D
- . S (SCTMLVL,SCPCLVL,SCNVALVL,SCMHLVL,SCOELVL,SCSPLVL,SCSPTYPE,SCSPMBR,SCCNT,SCBLOCK,SCEOF)=0
- . S SCGFICN=$$GETICN^MPIF001(SCDFN)
- . S SCDATA("webServiceParameters")="/"_"icn"_"/"_SCGFICN_".xml"
- . S (SCFALSE,SCVALUE)=""
- . S SCGETRC=$$GET^XOBWLIB(SCDATA("restObject"),SCDATA("webServiceParameters"),.SCERR,0)
- . I 'SCGETRC D Q
- . . S SCRC=$$GET1^DIQ(404.41,SCDFN_",",.07,"","SCDISPLY")
- . . I $G(SCDISPLY(1))="" D
- . . . S SCDISPLY(1)="PCMM is unavailable."
- . ;Q
- ;END RTW SD*5.3*854
- ;
- ; Retrieve the resource; execute HTTP GET method
- SCDFN ;
- 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
- S (SCTMLVL,SCPCLVL,SCNVALVL,SCMHLVL,SCOELVL,SCSPLVL,SCSPTYPE,SCSPMBR,SCCNT,SCBLOCK,SCEOF)=0
- I SCVCNT<2 F Q:SCEOF!SCREADR.EOF!'SCREADR.Read() DO
- . ; Get element value
- . IF (SCREADR.NodeType="chars") DO
- . . SET SCNODE=SCREADR.Path
- . . SET SCVALUE=SCREADR.Value
- . . I SCVALUE["false" S SCFALSE=SCVALUE,SCVCNT=SCVCNT+1,SCDFNSAVE=SCDFN G SCDICN ;RTW SD**5.3*854
- . . 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)
- I $D(SCDFNSAVE) S SCOUTFLD(.04)=1 S SCX=$$ACOUTPT^SCAPMC20(SCDFN,"SCOUTFLD","SCBADOUT")
- 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 this VA location (Click for more)" ;RTW SD*5.3*854
- . ;SET SCDISPLY(SCDISPSV)=" No PACT assigned at any VA location." ;RTW REMOUT SD*5.3*854
- IF '$DATA(SCTEAMS) DO
- . SET SCDISP=SCDISP+1
- . SET SCDISPLY(SCDISP)=""
- . SET SCDISP=SCDISP+1
- . SET SCDISPLY(SCDISP)=" No PACT assigned at this VA location (Click for more)" ;RTW SD*5.3*854
- . ;SET SCDISPLY(SCDISP)=" No PACT assigned at any VA location." ;RTW REMOUT SD*5.3*854
- ; 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 14606 printed Jan 18, 2025@03:42:54 Page 2
- SCMCWS1 ;ALB/ART - PCMM Web-Call Patient Summary Web Service ;02/06/2015
- +1 ;;5.3;Scheduling;**603,854**;Aug 13, 1993;Build 4
- +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 ; #20150204-01 SACC EXEMPTION for Vendor specific code is restricted.
- +15 ;
- 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,SCGFICN,SCFALSE,SCVCNT,SCDFNSAVE
- +11 ;
- +12 SET SCVCNT=0
- +13 IF $$PROD^XUPROD
- Begin DoDot:1
- +14 SET SCDATA("serverNameKey")="PCMMR SERVER"
- End DoDot:1
- +15 IF '$TEST
- Begin DoDot:1
- +16 SET SCDATA("serverNameKey")="PCMMR TEST SERVER"
- End DoDot:1
- +17 SET SCDATA("webServiceName")="PCMM-R GET PC INFO REST"
- +18 ;
- +19 ; Web service setup
- +20 SET SCRC=+$$SETUP^SCMCWSUT(.SCDATA)
- +21 IF SCRC=0
- Begin DoDot:1
- +22 SET SCDISPLY(1)=$PIECE(SCRC,U,2)
- End DoDot:1
- QUIT
- +23 ;
- +24 ; Get client REST request object
- +25 SET SCDATA("restObject")=$$GETREST^XOBWLIB(SCDATA("webServiceName"),SCDATA("serverName"))
- +26 ;
- +27 ; Get Local Site ID
- +28 ;Institution file pointer^Institution name^station number with suffix
- +29 SET SCDATA("site")=$PIECE($$SITE^VASITE(),U,3)
- +30 ;
- +31 ; Set PCMM/R web service parameters
- +32 SET SCDATA("webServiceParameters")="/"_SCDATA("site")_"/"_SCDFN_".xml"
- +33 ;
- +34 IF SCVCNT<1
- IF (SCVCNT>1)
- DO SCDFN
- +35 ;
- SCDICN ;START ICN FIND RTW SD*5.3*854
- +1 if SCVCNT>1
- QUIT
- +2 IF $DATA(SCFALSE)
- IF SCVCNT<2
- Begin DoDot:1
- +3 SET (SCTMLVL,SCPCLVL,SCNVALVL,SCMHLVL,SCOELVL,SCSPLVL,SCSPTYPE,SCSPMBR,SCCNT,SCBLOCK,SCEOF)=0
- +4 SET SCGFICN=$$GETICN^MPIF001(SCDFN)
- +5 SET SCDATA("webServiceParameters")="/"_"icn"_"/"_SCGFICN_".xml"
- +6 SET (SCFALSE,SCVALUE)=""
- +7 SET SCGETRC=$$GET^XOBWLIB(SCDATA("restObject"),SCDATA("webServiceParameters"),.SCERR,0)
- +8 IF 'SCGETRC
- Begin DoDot:2
- +9 SET SCRC=$$GET1^DIQ(404.41,SCDFN_",",.07,"","SCDISPLY")
- +10 IF $GET(SCDISPLY(1))=""
- Begin DoDot:3
- +11 SET SCDISPLY(1)="PCMM is unavailable."
- End DoDot:3
- End DoDot:2
- QUIT
- +12 ;Q
- End DoDot:1
- +13 ;END RTW SD*5.3*854
- +14 ;
- +15 ; Retrieve the resource; execute HTTP GET method
- SCDFN ;
- +1 SET SCGETRC=$$GET^XOBWLIB(SCDATA("restObject"),SCDATA("webServiceParameters"),.SCERR,0)
- +2 IF 'SCGETRC
- Begin DoDot:1
- +3 SET SCRC=$$GET1^DIQ(404.41,SCDFN_",",.07,"","SCDISPLY")
- +4 IF $GET(SCDISPLY(1))=""
- Begin DoDot:2
- +5 SET SCDISPLY(1)="PCMM is unavailable."
- End DoDot:2
- End DoDot:1
- QUIT
- +6 ;
- +7 ; Parse the XML stream
- +8 SET SCSTAT=##class(%XML.TextReader).ParseStream(SCDATA("restObject").HttpResponse.Data,.SCREADR)
- +9 ;
- +10 ; Check XML parse error
- +11 IF 'SCSTAT
- Begin DoDot:1
- +12 SET SCDISPLY(1)=">>> ERROR reading XML <<<"
- +13 SET SCDISPLY(2)=" Invalid XML Format"
- End DoDot:1
- QUIT
- +14 ;
- +15 ; Process XML
- +16 SET (SCTMLVL,SCPCLVL,SCNVALVL,SCMHLVL,SCOELVL,SCSPLVL,SCSPTYPE,SCSPMBR,SCCNT,SCBLOCK,SCEOF)=0
- +17 IF SCVCNT<2
- FOR
- if SCEOF!SCREADR.EOF!'SCREADR.Read()
- QUIT
- Begin DoDot:1
- +18 ; Get element value
- +19 IF (SCREADR.NodeType="chars")
- Begin DoDot:2
- +20 SET SCNODE=SCREADR.Path
- +21 SET SCVALUE=SCREADR.Value
- +22 ;RTW SD**5.3*854
- IF SCVALUE["false"
- SET SCFALSE=SCVALUE
- SET SCVCNT=SCVCNT+1
- SET SCDFNSAVE=SCDFN
- GOTO SCDICN
- +23 DO PARSEXML^SCMCWS1A(SCNODE,SCVALUE,.SCTEAMS,.SCNVA,.SCTMLVL,.SCPCLVL,.SCNVALVL,.SCMHLVL,.SCOELVL,.SCSPLVL,.SCSPTYPE,.SCSPMBR,.SCBLOCK,.SCEOF)
- End DoDot:2
- +24 ; Check for last closing tag
- +25 IF (SCREADR.NodeType="endelement")&(SCREADR.LocalName="PatientSummary")
- Begin DoDot:2
- +26 SET SCEOF=1
- End DoDot:2
- End DoDot:1
- +27 ;
- +28 ; Get Ipatient Data
- +29 DO GETINPAT(SCDFN,.SCINPAT)
- +30 ;
- +31 ; Build Display Array
- +32 IF 'SCBLOCK
- Begin DoDot:1
- +33 DO BLDISPLY(.SCTEAMS,.SCINPAT,.SCNVA,.SCDISPLY,SCDATA("site"))
- End DoDot:1
- +34 IF '$TEST
- Begin DoDot:1
- +35 DO BLDBLOCK(.SCTEAMS,.SCINPAT,.SCDISPLY)
- End DoDot:1
- +36 ;
- +37 ;Save display array in OutPatient Profile
- +38 SET SCDISPLY(1)="ATTENTION: PCMM is unavailable, data is current as of: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)
- +39 IF $DATA(SCDFNSAVE)
- SET SCOUTFLD(.04)=1
- SET SCX=$$ACOUTPT^SCAPMC20(SCDFN,"SCOUTFLD","SCBADOUT")
- +40 DO WP^DIE(404.41,SCDFN_",",.07,"K","SCDISPLY")
- +41 SET SCDISPLY(1)=""
- +42 ;
- +43 QUIT
- +44 ;
- +45 ;
- 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 ;RTW SD*5.3*854
- SET SCDISPLY(SCDISPSV)=" No PACT assigned at this VA location (Click for more)"
- +127 ;SET SCDISPLY(SCDISPSV)=" No PACT assigned at any VA location." ;RTW REMOUT SD*5.3*854
- End DoDot:1
- +128 IF '$DATA(SCTEAMS)
- Begin DoDot:1
- +129 SET SCDISP=SCDISP+1
- +130 SET SCDISPLY(SCDISP)=""
- +131 SET SCDISP=SCDISP+1
- +132 ;RTW SD*5.3*854
- SET SCDISPLY(SCDISP)=" No PACT assigned at this VA location (Click for more)"
- +133 ;SET SCDISPLY(SCDISP)=" No PACT assigned at any VA location." ;RTW REMOUT SD*5.3*854
- End DoDot:1
- +134 ; Non-VA Providers
- +135 if '$DATA(SCNVA)
- QUIT
- +136 SET SCDISP=SCDISP+1
- +137 SET SCDISPLY(SCDISP)=""
- +138 SET SCLEVEL=""
- +139 FOR
- SET SCLEVEL=$ORDER(SCNVA(SCLEVEL))
- if SCLEVEL=""
- QUIT
- Begin DoDot:1
- +140 SET SCDISP=SCDISP+1
- +141 SET SCDISPLY(SCDISP)="Non-VA: "_$GET(SCNVA(SCLEVEL,"ROLE"))_" || "_$GET(SCNVA(SCLEVEL,"NAME"))_$$FMTPHPG("N","N",0)
- End DoDot:1
- +142 ;
- +143 QUIT
- +144 ;
- 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 ;