SCMCWSUT ;ALB/ART - PCMM Web Call Patient Summary Web Service ;09/11/2014
;;5.3;Scheduling;**603**;Aug 13, 1993;Build 79
;
QUIT
;
;Public, Supported ICRs
; #5421 - XOBWLIB - Public APIs for HWSC
; #2051 - Database Server API: Lookup Utilities (DIC)
; #2056 - Data Base Server API: Data Retriever Utilities (DIQ)
;
SETUP(SCDATA) ;Web service setup
; Lookup server name
; Validate server name
; Validate service name
; Get REST request object
; Inputs: SCDATA - array of variables, passed by reference
; Output:
; Returns: success = 1
; failure = 0^error message
;
NEW SCRC,SCSERVER,SCLIST
;
; Get PCMM/R Web Server Name
SET SCRC=$$SNAME4KY^XOBWLIB(SCDATA("serverNameKey"),.SCSERVER)
QUIT:'SCRC "0^>>> CONFIGURATION ERROR: No Server Key Definition <<<"
SET SCDATA("serverName")=SCSERVER
;
; Validate PCMM/R Web Server Name
DO LKUPSRVR(SCDATA("serverName"),.SCLIST)
QUIT:$GET(SCLIST(1))=0 "0^>>> CONFIGURATION ERROR: No Server Definition <<<"
;
; Validate PCMM/R Web Service Name
NEW SCLIST
DO LKUPSRVS(SCDATA("webServiceName"),.SCLIST)
QUIT:$GET(SCLIST(1))=0 "0^>>> CONFIGURATION ERROR: No Service Definition <<<"
;
QUIT 1
;
LKUPSRVR(SCNAME,SCLIST) ; Web Server Lookup
; Inputs: SCNAME - name of the server
; Output: SCLIST - list of matching IENs, by reference
; ien^name
;FIND^DIC(FILE,IENS,FIELDS,FLAGS,[.]VALUE,NUMBER,[.]INDEXES,[.]SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOT)
N I,SCRET,SCERR,Y
SET SCLIST(1)=0
; Fileman DBS Web Server Lookup
DO FIND^DIC(18.12,"","@;.01","P",SCNAME,"","B","","","SCRET","SCERR")
SET I=0
FOR SET I=$ORDER(SCRET("DILIST",I)) QUIT:'I DO
. SET SCLIST(I)=SCRET("DILIST",I,0)
QUIT
;
LKUPSRVS(SCNAME,SCLIST) ; Web Service Lookup
; Inputs: SCNAME - name of the service
; Output: SCLIST - list of matching IENs and names, by reference
; ien^name
;FIND^DIC(FILE,IENS,FIELDS,FLAGS,[.]VALUE,NUMBER,[.]INDEXES,[.]SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOT)
N I,SCRET,SCERR,Y
SET SCLIST(1)=0
; Fileman DBS Web Service Lookup
DO FIND^DIC(18.02,"","@;.01","P",SCNAME,"","B","","","SCRET","SCERR")
SET I=0
FOR SET I=$ORDER(SCRET("DILIST",I)) QUIT:'I DO
. SET SCLIST(I)=SCRET("DILIST",I,0)
QUIT
;
CPRSHEAD(SCDFN) ;Get data for CPRS PCMMR Header
; Inputs: SCDFN - Patient DFN
; Returns: String of PACT info from Outpatient Profile (404.41), CPRS Header Text (.06)
;
QUIT:$GET(SCDFN)="" "Internal Error: Missing DFN"
NEW SCIENS,SCTEXT
SET SCIENS=SCDFN_","
SET SCTEXT=$$GET1^DIQ(404.41,SCIENS,.06)
SET:SCTEXT="" SCTEXT="No PACT assigned at any VA location"
QUIT SCTEXT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCWSUT 2683 printed Oct 16, 2024@18:42:23 Page 2
SCMCWSUT ;ALB/ART - PCMM Web Call Patient Summary Web Service ;09/11/2014
+1 ;;5.3;Scheduling;**603**;Aug 13, 1993;Build 79
+2 ;
+3 QUIT
+4 ;
+5 ;Public, Supported ICRs
+6 ; #5421 - XOBWLIB - Public APIs for HWSC
+7 ; #2051 - Database Server API: Lookup Utilities (DIC)
+8 ; #2056 - Data Base Server API: Data Retriever Utilities (DIQ)
+9 ;
SETUP(SCDATA) ;Web service setup
+1 ; Lookup server name
+2 ; Validate server name
+3 ; Validate service name
+4 ; Get REST request object
+5 ; Inputs: SCDATA - array of variables, passed by reference
+6 ; Output:
+7 ; Returns: success = 1
+8 ; failure = 0^error message
+9 ;
+10 NEW SCRC,SCSERVER,SCLIST
+11 ;
+12 ; Get PCMM/R Web Server Name
+13 SET SCRC=$$SNAME4KY^XOBWLIB(SCDATA("serverNameKey"),.SCSERVER)
+14 if 'SCRC
QUIT "0^>>> CONFIGURATION ERROR: No Server Key Definition <<<"
+15 SET SCDATA("serverName")=SCSERVER
+16 ;
+17 ; Validate PCMM/R Web Server Name
+18 DO LKUPSRVR(SCDATA("serverName"),.SCLIST)
+19 if $GET(SCLIST(1))=0
QUIT "0^>>> CONFIGURATION ERROR: No Server Definition <<<"
+20 ;
+21 ; Validate PCMM/R Web Service Name
+22 NEW SCLIST
+23 DO LKUPSRVS(SCDATA("webServiceName"),.SCLIST)
+24 if $GET(SCLIST(1))=0
QUIT "0^>>> CONFIGURATION ERROR: No Service Definition <<<"
+25 ;
+26 QUIT 1
+27 ;
LKUPSRVR(SCNAME,SCLIST) ; Web Server Lookup
+1 ; Inputs: SCNAME - name of the server
+2 ; Output: SCLIST - list of matching IENs, by reference
+3 ; ien^name
+4 ;FIND^DIC(FILE,IENS,FIELDS,FLAGS,[.]VALUE,NUMBER,[.]INDEXES,[.]SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOT)
+5 NEW I,SCRET,SCERR,Y
+6 SET SCLIST(1)=0
+7 ; Fileman DBS Web Server Lookup
+8 DO FIND^DIC(18.12,"","@;.01","P",SCNAME,"","B","","","SCRET","SCERR")
+9 SET I=0
+10 FOR
SET I=$ORDER(SCRET("DILIST",I))
if 'I
QUIT
Begin DoDot:1
+11 SET SCLIST(I)=SCRET("DILIST",I,0)
End DoDot:1
+12 QUIT
+13 ;
LKUPSRVS(SCNAME,SCLIST) ; Web Service Lookup
+1 ; Inputs: SCNAME - name of the service
+2 ; Output: SCLIST - list of matching IENs and names, by reference
+3 ; ien^name
+4 ;FIND^DIC(FILE,IENS,FIELDS,FLAGS,[.]VALUE,NUMBER,[.]INDEXES,[.]SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOT)
+5 NEW I,SCRET,SCERR,Y
+6 SET SCLIST(1)=0
+7 ; Fileman DBS Web Service Lookup
+8 DO FIND^DIC(18.02,"","@;.01","P",SCNAME,"","B","","","SCRET","SCERR")
+9 SET I=0
+10 FOR
SET I=$ORDER(SCRET("DILIST",I))
if 'I
QUIT
Begin DoDot:1
+11 SET SCLIST(I)=SCRET("DILIST",I,0)
End DoDot:1
+12 QUIT
+13 ;
CPRSHEAD(SCDFN) ;Get data for CPRS PCMMR Header
+1 ; Inputs: SCDFN - Patient DFN
+2 ; Returns: String of PACT info from Outpatient Profile (404.41), CPRS Header Text (.06)
+3 ;
+4 if $GET(SCDFN)=""
QUIT "Internal Error: Missing DFN"
+5 NEW SCIENS,SCTEXT
+6 SET SCIENS=SCDFN_","
+7 SET SCTEXT=$$GET1^DIQ(404.41,SCIENS,.06)
+8 if SCTEXT=""
SET SCTEXT="No PACT assigned at any VA location"
+9 QUIT SCTEXT
+10 ;
