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 Mar 13, 2025@21:46:40 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 ;
