- SCMCWSUT ;ALB/ART - PCMM Web Call Patient Summary Web Service ;09/11/2014
- ;;5.3;Scheduling;**603,854**;Aug 13, 1993;Build 4
- ;
- 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 this VA location (Click for more)" ;RTW SD*5.3*854
- ;SET:SCTEXT="" SCTEXT="No PACT assigned at any VA location" ;sd*5.3*854
- QUIT SCTEXT
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCWSUT 2794 printed Jan 18, 2025@03:42:55 Page 2
- SCMCWSUT ;ALB/ART - PCMM Web Call Patient Summary Web Service ;09/11/2014
- +1 ;;5.3;Scheduling;**603,854**;Aug 13, 1993;Build 4
- +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 ;RTW SD*5.3*854
- if SCTEXT=""
- SET SCTEXT="No PACT assigned at this VA location (Click for more)"
- +9 ;SET:SCTEXT="" SCTEXT="No PACT assigned at any VA location" ;sd*5.3*854
- +10 QUIT SCTEXT
- +11 ;