Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCMCWS1

SCMCWS1.m

Go to the documentation of this file.
  1. SCMCWS1 ;ALB/ART - PCMM Web-Call Patient Summary Web Service ;02/06/2015
  1. ;;5.3;Scheduling;**603,854**;Aug 13, 1993;Build 4
  1. ;
  1. QUIT
  1. ;
  1. ;Public, Supported ICRs
  1. ; #2053 - Data Base Server API: Editing Utilities (DIE)
  1. ; #2056 - Data Base Server API: Data Retriever Utilities (DIQ)
  1. ; #4440 - DBIA4440 (XUPROD)
  1. ; #5421 - XOBWLIB - Public APIs for HWSC
  1. ; #10035 - PATIENT FILE
  1. ; #10060 - NEW PERSON FILE
  1. ; #10103 - XLFDT - Supported APIs for date & time
  1. ; #10112 - VASITE - Supported APIs for site info
  1. ; #20150204-01 SACC EXEMPTION for Vendor specific code is restricted.
  1. ;
  1. PCDETAIL(SCDISPLY,SCDFN) ;Call PCMM/R Web Service
  1. ;Inputs: SCDISPLY - Array for team assignment info - passed by reference
  1. ; SCDFN - Patient DFN
  1. ;Output: populated SCDISPLY
  1. ; ICR #6027 - SCMC PCMM/R GET PRIMARY CARE DETAILS
  1. ;
  1. NEW SCSERVER,SCSERVC,SCLIST,SCSRVRKY,SCRC
  1. NEW SCSTAT,SCEOF,SCREADR,SCCNT,SCARRAY,SCVALUE,SCNODE,SCROW
  1. NEW SCREST,SCGETRC,SCERR
  1. NEW SCTEAMS,SCINPAT,SCNVA,SCBLOCK,SCTMLVL,SCPCLVL,SCNVALVL,SCMHLVL,SCOELVL,SCSPLVL,SCSPTYPE,SCSPMBR
  1. NEW SCDATA,SCX,SCY,SCGFICN,SCFALSE,SCVCNT,SCDFNSAVE
  1. ;
  1. S SCVCNT=0
  1. IF $$PROD^XUPROD DO
  1. . SET SCDATA("serverNameKey")="PCMMR SERVER"
  1. ELSE DO
  1. . SET SCDATA("serverNameKey")="PCMMR TEST SERVER"
  1. SET SCDATA("webServiceName")="PCMM-R GET PC INFO REST"
  1. ;
  1. ; Web service setup
  1. SET SCRC=+$$SETUP^SCMCWSUT(.SCDATA)
  1. IF SCRC=0 DO QUIT
  1. . SET SCDISPLY(1)=$PIECE(SCRC,U,2)
  1. ;
  1. ; Get client REST request object
  1. SET SCDATA("restObject")=$$GETREST^XOBWLIB(SCDATA("webServiceName"),SCDATA("serverName"))
  1. ;
  1. ; Get Local Site ID
  1. ;Institution file pointer^Institution name^station number with suffix
  1. SET SCDATA("site")=$PIECE($$SITE^VASITE(),U,3)
  1. ;
  1. ; Set PCMM/R web service parameters
  1. SET SCDATA("webServiceParameters")="/"_SCDATA("site")_"/"_SCDFN_".xml"
  1. ;
  1. I SCVCNT<1,(SCVCNT>1) D SCDFN
  1. ;
  1. SCDICN ;START ICN FIND RTW SD*5.3*854
  1. Q:SCVCNT>1
  1. I $D(SCFALSE),SCVCNT<2 D
  1. . S (SCTMLVL,SCPCLVL,SCNVALVL,SCMHLVL,SCOELVL,SCSPLVL,SCSPTYPE,SCSPMBR,SCCNT,SCBLOCK,SCEOF)=0
  1. . S SCGFICN=$$GETICN^MPIF001(SCDFN)
  1. . S SCDATA("webServiceParameters")="/"_"icn"_"/"_SCGFICN_".xml"
  1. . S (SCFALSE,SCVALUE)=""
  1. . S SCGETRC=$$GET^XOBWLIB(SCDATA("restObject"),SCDATA("webServiceParameters"),.SCERR,0)
  1. . I 'SCGETRC D Q
  1. . . S SCRC=$$GET1^DIQ(404.41,SCDFN_",",.07,"","SCDISPLY")
  1. . . I $G(SCDISPLY(1))="" D
  1. . . . S SCDISPLY(1)="PCMM is unavailable."
  1. . ;Q
  1. ;END RTW SD*5.3*854
  1. ;
  1. ; Retrieve the resource; execute HTTP GET method
  1. SCDFN ;
  1. SET SCGETRC=$$GET^XOBWLIB(SCDATA("restObject"),SCDATA("webServiceParameters"),.SCERR,0)
  1. IF 'SCGETRC DO QUIT
  1. . SET SCRC=$$GET1^DIQ(404.41,SCDFN_",",.07,"","SCDISPLY")
  1. . IF $GET(SCDISPLY(1))="" DO
  1. . . SET SCDISPLY(1)="PCMM is unavailable."
  1. ;
  1. ; Parse the XML stream
  1. SET SCSTAT=##class(%XML.TextReader).ParseStream(SCDATA("restObject").HttpResponse.Data,.SCREADR)
  1. ;
  1. ; Check XML parse error
  1. IF 'SCSTAT DO QUIT
  1. . SET SCDISPLY(1)=">>> ERROR reading XML <<<"
  1. . SET SCDISPLY(2)=" Invalid XML Format"
  1. ;
  1. ; Process XML
  1. S (SCTMLVL,SCPCLVL,SCNVALVL,SCMHLVL,SCOELVL,SCSPLVL,SCSPTYPE,SCSPMBR,SCCNT,SCBLOCK,SCEOF)=0
  1. I SCVCNT<2 F Q:SCEOF!SCREADR.EOF!'SCREADR.Read() DO
  1. . ; Get element value
  1. . IF (SCREADR.NodeType="chars") DO
  1. . . SET SCNODE=SCREADR.Path
  1. . . SET SCVALUE=SCREADR.Value
  1. . . I SCVALUE["false" S SCFALSE=SCVALUE,SCVCNT=SCVCNT+1,SCDFNSAVE=SCDFN G SCDICN ;RTW SD**5.3*854
  1. . . DO PARSEXML^SCMCWS1A(SCNODE,SCVALUE,.SCTEAMS,.SCNVA,.SCTMLVL,.SCPCLVL,.SCNVALVL,.SCMHLVL,.SCOELVL,.SCSPLVL,.SCSPTYPE,.SCSPMBR,.SCBLOCK,.SCEOF)
  1. . ; Check for last closing tag
  1. . IF (SCREADR.NodeType="endelement")&(SCREADR.LocalName="PatientSummary") DO
  1. . . SET SCEOF=1
  1. ;
  1. ; Get Ipatient Data
  1. DO GETINPAT(SCDFN,.SCINPAT)
  1. ;
  1. ; Build Display Array
  1. IF 'SCBLOCK DO
  1. . DO BLDISPLY(.SCTEAMS,.SCINPAT,.SCNVA,.SCDISPLY,SCDATA("site"))
  1. ELSE DO
  1. . DO BLDBLOCK(.SCTEAMS,.SCINPAT,.SCDISPLY)
  1. ;
  1. ;Save display array in OutPatient Profile
  1. SET SCDISPLY(1)="ATTENTION: PCMM is unavailable, data is current as of: "_$$FMTE^XLFDT($$NOW^XLFDT(),2)
  1. I $D(SCDFNSAVE) S SCOUTFLD(.04)=1 S SCX=$$ACOUTPT^SCAPMC20(SCDFN,"SCOUTFLD","SCBADOUT")
  1. DO WP^DIE(404.41,SCDFN_",",.07,"K","SCDISPLY")
  1. SET SCDISPLY(1)=""
  1. ;
  1. QUIT
  1. ;
  1. ;
  1. GETINPAT(SCDFN,SCINPAT) ;Build an array of local attending and inpatient providers
  1. ;Inputs: SCDFN - patient DFN
  1. ; SCINPAT - inpatient provider array - by reference
  1. ;Output: Populated inpatient provider array
  1. ;
  1. NEW SCATT,SCPROV
  1. ;If patient is assigned to a ward
  1. IF $$GET1^DIQ(2,SCDFN_",",.1)'="" DO
  1. . SET SCATT=$$GET1^DIQ(2,SCDFN_",",.1041,"I")
  1. . SET SCPROV=$$GET1^DIQ(2,SCDFN_",",.104,"I")
  1. . ;populate array from New Person File
  1. . IF +SCATT DO
  1. . . SET SCINPAT("ATT NAME")=$$GET1^DIQ(200,+SCATT_",",.01)
  1. . . SET SCINPAT("ATT PHONE")=$$GET1^DIQ(200,+SCATT_",",.132)
  1. . . SET SCINPAT("ATT PAGER")=$$GET1^DIQ(200,+SCATT_",",.138)
  1. . IF +SCPROV DO
  1. . . SET SCINPAT("PROV NAME")=$$GET1^DIQ(200,+SCPROV_",",.01)
  1. . . SET SCINPAT("PROV PHONE")=$$GET1^DIQ(200,+SCPROV_",",.132)
  1. . . SET SCINPAT("PROV PAGER")=$$GET1^DIQ(200,+SCPROV_",",.138)
  1. QUIT
  1. ;
  1. BLDBLOCK(SCTEAMS,SCINPAT,SCDISPLY) ; Build the Display Array
  1. ;Inputs: SCTEAMS - Teams array - by reference
  1. ; SCINPAT - inpatient array - by reference
  1. ; SCDISPLY - Display array - by reference
  1. ;Output: Populated Display Array
  1. ;
  1. NEW SCDISP,SCSKIP,SCI
  1. ;
  1. SET SCDISP=1
  1. SET SCSKIP=0
  1. SET SCDISPLY(SCDISP)=""
  1. ;Inpatient providers
  1. IF $GET(SCINPAT("ATT NAME"))'="" DO
  1. . SET SCDISP=SCDISP+1
  1. . SET SCSKIP=1
  1. . SET SCDISPLY(SCDISP)=" Inpatient Attending: "_$GET(SCINPAT("ATT NAME"))_$$FMTPHPG("I","ATT",0)
  1. IF $GET(SCINPAT("PROV NAME"))'="" DO
  1. . SET SCDISP=SCDISP+1
  1. . SET SCSKIP=1
  1. . SET SCDISPLY(SCDISP)=" Inpatient Provider: "_$GET(SCINPAT("PROV NAME"))_$$FMTPHPG("I","PROV",0)
  1. IF SCSKIP DO
  1. . SET SCDISP=SCDISP+1
  1. . SET SCDISPLY(SCDISP)=""
  1. ;
  1. FOR SCI=1:1 QUIT:'$DATA(SCTEAMS(SCI)) DO
  1. . SET SCDISP=SCDISP+1
  1. . SET SCDISPLY(SCDISP)=SCTEAMS(SCI)
  1. ;
  1. QUIT
  1. ;
  1. BLDISPLY(SCTEAMS,SCINPAT,SCNVA,SCDISPLY,SCSITE) ; Build the Display Array
  1. ;Inputs: SCTEAMS - Teams array - by reference
  1. ; SCINPAT - inpatient array - by reference
  1. ; SCNVA - nonVA array - by reference
  1. ; SCDISPLY - Display array - by reference
  1. ; SCSITE - Site Number
  1. ;Output: Populated Display Array
  1. ;
  1. NEW SCDISP,SCX,SCY,SCZ,SCLEVEL,SCLEVEL2,SCSTAT,SCXSITE,SCLOCAL,SCTMCNT,SCDISPSV,SCTYPE,SCSKIP,SCOTHTM
  1. SET SCDISP=0
  1. SET SCTMCNT=0
  1. SET SCDISPSV=0
  1. SET SCSKIP=0
  1. SET SCOTHTM=0
  1. ;Teams from web service call
  1. SET SCLEVEL=""
  1. FOR SET SCLEVEL=$ORDER(SCTEAMS(SCLEVEL)) QUIT:SCLEVEL="" DO
  1. . SET SCDISP=SCDISP+1
  1. . SET SCDISPLY(SCDISP)=""
  1. . ;Check for local site
  1. . SET SCXSITE=$TR($PIECE($GET(SCTEAMS(SCLEVEL,"STATION")),"(",2),"#)","")
  1. . SET SCLOCAL=$SELECT(SCSITE=SCXSITE:1,1:0)
  1. . IF SCLOCAL DO
  1. . . SET SCDISP=SCDISP+1
  1. . . SET SCDISPLY(SCDISP)="LOCAL - "_$GET(SCTEAMS(SCLEVEL,"STATION"))
  1. . . ;Inpatient providers
  1. . . IF $GET(SCINPAT("ATT NAME"))'="" DO
  1. . . . SET SCDISP=SCDISP+1
  1. . . . SET SCSKIP=1
  1. . . . SET SCDISPLY(SCDISP)=" Inpatient Attending: "_$GET(SCINPAT("ATT NAME"))_$$FMTPHPG("I","ATT",0)
  1. . . IF $GET(SCINPAT("PROV NAME"))'="" DO
  1. . . . SET SCDISP=SCDISP+1
  1. . . . SET SCSKIP=1
  1. . . . SET SCDISPLY(SCDISP)=" Inpatient Provider: "_$GET(SCINPAT("PROV NAME"))_$$FMTPHPG("I","PROV",0)
  1. . ELSE DO
  1. . . SET SCDISP=SCDISP+1
  1. . . SET SCDISPLY(SCDISP)="REMOTE - "_$GET(SCTEAMS(SCLEVEL,"STATION"))
  1. . IF SCLOCAL,SCSKIP DO
  1. . . SET SCDISP=SCDISP+1
  1. . . SET SCDISPLY(SCDISP)=""
  1. . ;
  1. . ;PACT
  1. . IF '$DATA(SCTEAMS(SCLEVEL,2)) DO
  1. . . IF SCLOCAL DO
  1. . . . SET SCDISP=SCDISP+1
  1. . . . SET SCDISPSV=SCDISP
  1. . . . SET SCDISPLY(SCDISP)=" PACT: No Local PACT Assigned."
  1. . SET SCY=""
  1. . FOR SET SCY=$ORDER(SCTEAMS(SCLEVEL,2,SCY)) QUIT:SCY="" DO
  1. . . IF $GET(SCTEAMS(SCLEVEL,2,SCY,"PACT"))'="" DO
  1. . . . SET SCTMCNT=SCTMCNT+1
  1. . . . SET SCSTAT=$GET(SCTEAMS(SCLEVEL,2,SCY,"STATUS"))
  1. . . . SET SCSTAT=$SELECT(SCSTAT="Pending":"PENDING: ",1:"")
  1. . . . SET SCDISP=SCDISP+1
  1. . . . SET SCDISPLY(SCDISP)=" PACT: "_SCSTAT_$GET(SCTEAMS(SCLEVEL,2,SCY,"PACT"))
  1. . . . SET SCDISP=SCDISP+1
  1. . . . IF $GET(SCTEAMS(SCLEVEL,2,SCY,"PCP NAME"))'="" DO
  1. . . . . SET SCDISPLY(SCDISP)=" Primary Care Provider: "_$GET(SCTEAMS(SCLEVEL,2,SCY,"PCP NAME"))_$$FMTPHPG("P","PCP",2)
  1. . . . ELSE DO
  1. . . . . SET SCDISPLY(SCDISP)=" Primary Care Provider: Vacant"
  1. . . . IF $GET(SCTEAMS(SCLEVEL,2,SCY,"ASSOC NAME"))'="" DO
  1. . . . . SET SCDISP=SCDISP+1
  1. . . . . SET SCDISPLY(SCDISP)=" Associate Provider: "_$GET(SCTEAMS(SCLEVEL,2,SCY,"ASSOC NAME"))_$$FMTPHPG("P","ASSOC",2)
  1. . . . SET SCDISP=SCDISP+1
  1. . . . IF $GET(SCTEAMS(SCLEVEL,2,SCY,"APOC NAME"))'="" DO
  1. . . . . SET SCDISPLY(SCDISP)=" Administrative POC: "_$GET(SCTEAMS(SCLEVEL,2,SCY,"APOC ROLE"))_" || "_$GET(SCTEAMS(SCLEVEL,2,SCY,"APOC NAME"))_$$FMTPHPG("P","APOC",2)
  1. . . . ELSE DO
  1. . . . . SET SCDISPLY(SCDISP)=" Administrative POC: Vacant"
  1. . . . SET SCDISP=SCDISP+1
  1. . . . IF $GET(SCTEAMS(SCLEVEL,2,SCY,"CPOC NAME"))'="" DO
  1. . . . . SET SCDISPLY(SCDISP)=" Clinical POC: "_$GET(SCTEAMS(SCLEVEL,2,SCY,"CPOC ROLE"))_" || "_$GET(SCTEAMS(SCLEVEL,2,SCY,"CPOC NAME"))_$$FMTPHPG("P","CPOC",2)
  1. . . . ELSE DO
  1. . . . . SET SCDISPLY(SCDISP)=" Clinical POC: Vacant"
  1. . . ELSE DO ;No Local PACT Assigned
  1. . . . IF SCLOCAL DO
  1. . . . . SET SCDISP=SCDISP+1
  1. . . . . SET SCDISPSV=SCDISP
  1. . . . . SET SCDISPLY(SCDISP)=" PACT: No Local PACT Assigned."
  1. . ;
  1. . ; Mental Health
  1. . SET SCY=""
  1. . FOR SET SCY=$ORDER(SCTEAMS(SCLEVEL,4,SCY)) QUIT:SCY="" DO
  1. . . IF $GET(SCTEAMS(SCLEVEL,4,SCY,"SP TEAM"))'="" DO
  1. . . . SET SCDISP=SCDISP+1
  1. . . . SET SCDISPLY(SCDISP)=""
  1. . . . SET SCDISP=SCDISP+1
  1. . . . SET SCDISPLY(SCDISP)=" MH: "_$GET(SCTEAMS(SCLEVEL,4,SCY,"SP TEAM"))
  1. . . . SET SCZ=0
  1. . . . FOR SET SCZ=$ORDER(SCTEAMS(SCLEVEL,4,SCY,SCZ)) QUIT:'SCZ DO
  1. . . . . SET SCDISP=SCDISP+1
  1. . . . . SET SCDISPLY(SCDISP)=" "_$GET(SCTEAMS(SCLEVEL,4,SCY,SCZ,"SP ROLE"))_" || "_$GET(SCTEAMS(SCLEVEL,4,SCY,SCZ,"SP NAME"))_$$FMTPHPG("S","SP",4)
  1. . . . SET:SCLOCAL SCOTHTM=1
  1. . ;
  1. . ; OEF/OIF/OND
  1. . SET SCY=""
  1. . FOR SET SCY=$ORDER(SCTEAMS(SCLEVEL,"OEF",SCY)) QUIT:SCY="" DO
  1. . . IF ($GET(SCTEAMS(SCLEVEL,"OEF",SCY,"OEF TEAM"))'="")!($GET(SCTEAMS(SCLEVEL,"OEF",SCY,"OEF MGR"))'="") DO
  1. . . . SET SCDISP=SCDISP+1
  1. . . . SET SCDISPLY(SCDISP)=""
  1. . . . SET SCDISP=SCDISP+1
  1. . . . SET SCDISPLY(SCDISP)=" OEF/OIF/OND: "_$GET(SCTEAMS(SCLEVEL,"OEF",SCY,"OEF TEAM"))
  1. . . . SET SCDISP=SCDISP+1
  1. . . . SET SCDISPLY(SCDISP)=" LEAD COORDINATOR: "_$GET(SCTEAMS(SCLEVEL,"OEF",SCY,"OEF MGR"))_$$FMTPHPG("O","OEF","OEF")
  1. . . . SET:SCLOCAL SCOTHTM=1
  1. . ;
  1. . ; Specialty
  1. . SET SCX=""
  1. . FOR SET SCX=$ORDER(SCTEAMS(SCLEVEL,SCX)) QUIT:'+SCX DO
  1. . . QUIT:SCX=4 ;MH
  1. . . QUIT:SCX=2 ;PC
  1. . . QUIT:SCX=10 ;OEF
  1. . . SET SCY=0
  1. . . FOR SET SCY=$ORDER(SCTEAMS(SCLEVEL,SCX,SCY)) QUIT:'+SCY DO
  1. . . . IF ($GET(SCTEAMS(SCLEVEL,SCX,SCY,"SP TEAM"))'="")!($GET(SCTEAMS(SCLEVEL,SCX,SCY,"SP ROLE"))'="") DO
  1. . . . . SET SCDISP=SCDISP+1
  1. . . . . SET SCDISPLY(SCDISP)=""
  1. . . . . SET SCDISP=SCDISP+1
  1. . . . SET SCDISPLY(SCDISP)=" SP: "_$GET(SCTEAMS(SCLEVEL,SCX,SCY,"SP TEAM"))
  1. . . . SET SCZ=0
  1. . . . FOR SET SCZ=$ORDER(SCTEAMS(SCLEVEL,SCX,SCY,SCZ)) QUIT:'SCZ DO
  1. . . . . SET SCDISP=SCDISP+1
  1. . . . . SET SCDISPLY(SCDISP)=" "_$GET(SCTEAMS(SCLEVEL,SCX,SCY,SCZ,"SP ROLE"))_" || "_$GET(SCTEAMS(SCLEVEL,SCX,SCY,SCZ,"SP NAME"))_$$FMTPHPG("S","SP",SCX)
  1. . . . SET:SCLOCAL SCOTHTM=1
  1. ;Check if PACTs assigned
  1. IF 'SCTMCNT,SCDISPSV DO
  1. . SET:'SCOTHTM SCDISPLY(SCDISPSV-1)=""
  1. . SET SCDISPLY(SCDISPSV)=" No PACT assigned at this VA location (Click for more)" ;RTW SD*5.3*854
  1. . ;SET SCDISPLY(SCDISPSV)=" No PACT assigned at any VA location." ;RTW REMOUT SD*5.3*854
  1. IF '$DATA(SCTEAMS) DO
  1. . SET SCDISP=SCDISP+1
  1. . SET SCDISPLY(SCDISP)=""
  1. . SET SCDISP=SCDISP+1
  1. . SET SCDISPLY(SCDISP)=" No PACT assigned at this VA location (Click for more)" ;RTW SD*5.3*854
  1. . ;SET SCDISPLY(SCDISP)=" No PACT assigned at any VA location." ;RTW REMOUT SD*5.3*854
  1. ; Non-VA Providers
  1. QUIT:'$DATA(SCNVA)
  1. SET SCDISP=SCDISP+1
  1. SET SCDISPLY(SCDISP)=""
  1. SET SCLEVEL=""
  1. FOR SET SCLEVEL=$ORDER(SCNVA(SCLEVEL)) QUIT:SCLEVEL="" DO
  1. . SET SCDISP=SCDISP+1
  1. . SET SCDISPLY(SCDISP)="Non-VA: "_$GET(SCNVA(SCLEVEL,"ROLE"))_" || "_$GET(SCNVA(SCLEVEL,"NAME"))_$$FMTPHPG("N","N",0)
  1. ;
  1. QUIT
  1. ;
  1. 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
  1. ; SCPREFIX - Value of Prefix
  1. ; SCTEAMID - Value of team ID
  1. ;Returns: Phone and Pager string
  1. ;
  1. QUIT:$GET(SCTYPE)="" -1
  1. QUIT:$GET(SCPREFIX)="" -2
  1. QUIT:$GET(SCTEAMID)="" -3
  1. NEW SCPPSTR
  1. SET SCPPSTR=""
  1. ; Inpatient
  1. IF SCTYPE="I" DO
  1. . SET SCPPSTR=$SELECT($GET(SCINPAT(SCPREFIX_" PHONE"))="":"",1:" || PHONE:"_SCINPAT(SCPREFIX_" PHONE"))
  1. . SET SCPPSTR=SCPPSTR_$S($GET(SCINPAT(SCPREFIX_" PAGER"))="":"",1:" || PAGER:"_SCINPAT(SCPREFIX_" PAGER"))
  1. ; Primary Care
  1. IF SCTYPE="P" DO
  1. . SET SCPPSTR=$SELECT($GET(SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCPREFIX_" PHONE"))="":"",1:" || PHONE:"_SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCPREFIX_" PHONE"))
  1. . SET SCPPSTR=SCPPSTR_$SELECT($GET(SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCPREFIX_" PAGER"))="":"",1:" || PAGER:"_SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCPREFIX_" PAGER"))
  1. ; Specialty & MH
  1. IF SCTYPE="S" DO
  1. . SET SCPPSTR=$SELECT($GET(SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCZ,SCPREFIX_" PHONE"))="":"",1:" || PHONE:"_SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCZ,SCPREFIX_" PHONE"))
  1. . SET SCPPSTR=SCPPSTR_$S($GET(SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCZ,SCPREFIX_" PAGER"))="":"",1:" || PAGER:"_SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCZ,SCPREFIX_" PAGER"))
  1. ; OEF/OIF
  1. IF SCTYPE="O" DO
  1. . SET SCPPSTR=$SELECT($GET(SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCPREFIX_" PHONE"))="":"",1:" || PHONE:"_SCTEAMS(SCLEVEL,SCPREFIX,SCY,SCPREFIX_" PHONE"))
  1. . SET SCPPSTR=SCPPSTR_$S($GET(SCTEAMS(SCLEVEL,SCTEAMID,SCY,SCPREFIX_" PAGER"))="":"",1:" || PAGER:"_SCTEAMS(SCLEVEL,SCPREFIX,SCY,SCPREFIX_" PAGER"))
  1. ; Non-VA
  1. IF SCTYPE="N" DO
  1. . SET SCPPSTR=$SELECT($GET(SCNVA(SCLEVEL,"PHONE"))="":"",1:" || PHONE:"_SCNVA(SCLEVEL,"PHONE"))
  1. . SET SCPPSTR=SCPPSTR_$SELECT($GET(SCNVA(SCLEVEL,"CITY"))="":"",1:" || CITY: "_SCNVA(SCLEVEL,"CITY"))
  1. . SET SCPPSTR=SCPPSTR_$SELECT($GET(SCNVA(SCLEVEL,"STATE"))="":"",1:" || STATE: "_SCNVA(SCLEVEL,"STATE"))
  1. ;
  1. QUIT SCPPSTR
  1. ;