PSSHRQ2O ;WOIFO/AV,TS,SG - Handles parsing a PEPS Drug Check Response ;09/20/07
;;1.0;PHARMACY DATA MANAGEMENT;**136,160**;9/30/97;Build 76
;
; @authors - Chris Flegel, Alex Vazquez, Tim Sabat
; @date - September 19, 2007
; @version - 1.0
;
QUIT
;;
OUT(DOCHAND,BASE) ;
; @DESC Parses the PEPSResponse XML and stores in object
;
; @DOCHAND Handle to XML document
; @BASE Base of output global
;
NEW PSS,HASH,MESSAGE
;
SET PSS("rootName")=$$NAME^MXMLDOM(DOCHAND,1)
;
IF PSS("rootName")="exception" DO
. ; Read error into hash variable
. DO ERREAD(DOCHAND,.HASH)
. ; Write hashed variable to output global
. IF HASH("code")="FDBUPDATE" S MESSAGE="Vendor database updates are being processed." ; HASH("message")
. ELSE IF $D(^TMP($J,BASE,"IN","DOSE"))>0 SET MESSAGE="An unexpected error has occurred."
. ELSE SET MESSAGE="An unexpected error has occurred."
. SET ^TMP($JOB,BASE,"OUT",0)="-1^"_MESSAGE
. ;
. ; Cleanup the out.exception global
. KILL ^TMP($JOB,"OUT","EXCEPTION")
;
IF PSS("rootName")="PEPSResponse" DO HNDLCK(DOCHAND,BASE)
;
; Clean up after using the handle
DO DELETE^MXMLDOM(DOCHAND)
KILL ^TMP($J,"OUT XML")
QUIT
;
HNDLCK(DOCHAND,BASE) ;
; @DESC This handles the parsing of the PEPSResponse XML element
;
; @DOCHAND Handle to XML document
; @BASE Base of output global
;
; @RETURNS Nothing
;
NEW PSS
;
; if ping get the vendor database info and exit.
IF $D(^TMP($JOB,BASE,"IN","PING")) SET ^TMP($JOB,BASE,"OUT",0)=0 DO GTDBINFO(DOCHAND,BASE) QUIT
;
; Get handle to drugCheck XML element
SET PSS("drugCheck")=$$GTHANDLE(DOCHAND)
SET PSS("child")=0
; Loop through elements of drugCheck
FOR SET PSS("child")=$$CHILD^MXMLDOM(DOCHAND,PSS("drugCheck"),PSS("child")) QUIT:PSS("child")=0 DO
. SET PSS("childName")=$$NAME^MXMLDOM(DOCHAND,PSS("child"))
. ;
. ; Build executable string
. SET PSS("tag")=$$SELTAG(PSS("childName"))
. SET PSS("executable")="DO "_PSS("tag")_"(DOCHAND,PSS(""child""),BASE)"
. ;
. XECUTE PSS("executable")
. QUIT
;
; Set top level node to 1 or 0
IF $DATA(^TMP($JOB,BASE,"OUT"))>1 SET ^TMP($JOB,BASE,"OUT",0)=1
IF $DATA(^TMP($JOB,BASE,"OUT"))<10 SET ^TMP($JOB,BASE,"OUT",0)=0
QUIT
;
GTDBINFO(DOCHAND,BASE) ; get the Vendor database info.
; @DOCHAND Handle to XML document
; @BASE Base of output global
;
NEW PSS,HEADER
SET PSS("child")=0
SET PSS("childName")=""
; get <Header> child
FOR DO QUIT:PSS("childName")="Header"
. SET PSS("child")=$$CHILD^MXMLDOM(DOCHAND,1,PSS("child"))
. SET PSS("childName")=$$NAME^MXMLDOM(DOCHAND,PSS("child"))
;
; get <PEPSVersion> child of <Header> element
SET HEADER=PSS("child")
SET PSS("child")=0
FOR DO QUIT:PSS("childName")="PEPSVersion"
. SET PSS("child")=$$CHILD^MXMLDOM(DOCHAND,HEADER,PSS("child"))
. SET PSS("childName")=$$NAME^MXMLDOM(DOCHAND,PSS("child"))
;
SET ^TMP($JOB,BASE,"OUT","difIssueDate")=$$VALUE^MXMLDOM(DOCHAND,PSS("child"),"difIssueDate")
SET ^TMP($JOB,BASE,"OUT","difBuildVersion")=$$VALUE^MXMLDOM(DOCHAND,PSS("child"),"difBuildVersion")
SET ^TMP($JOB,BASE,"OUT","difDbVersion")=$$VALUE^MXMLDOM(DOCHAND,PSS("child"),"difDbVersion")
SET ^TMP($JOB,BASE,"OUT","customIssueDate")=$$VALUE^MXMLDOM(DOCHAND,PSS("child"),"customIssueDate")
SET ^TMP($JOB,BASE,"OUT","customBuildVersion")=$$VALUE^MXMLDOM(DOCHAND,PSS("child"),"customBuildVersion")
SET ^TMP($JOB,BASE,"OUT","customDbVersion")=$$VALUE^MXMLDOM(DOCHAND,PSS("child"),"customDbVersion")
QUIT
;
GTHANDLE(DOCHAND) ;
; @DESC Get handle to drugCheck element from PEPSResponse element
;
; @DOCHAND Handle to XML document
;
; @RETURNS Handle to drugCheck XML element
;
NEW PSS
;
SET PSS("child")=0
;
; Get next child of root element
FOR SET PSS("child")=$$CHILD^MXMLDOM(DOCHAND,1,PSS("child")) QUIT:PSS("child")=0 DO
. SET PSS("childName")=$$NAME^MXMLDOM(DOCHAND,PSS("child"))
. SET:PSS("childName")="Body" PSS("drugCheckElement")=$$CHILD^MXMLDOM(DOCHAND,PSS("child"))
;
QUIT PSS("drugCheckElement")
;
SELTAG(NAME) ;
; @DESC Returns the appropriate tag to handle the XML element
;
; @NAME Name of the current XML element
;
; @RETURNS Returns the appropriate tag to handle the XML element
;
QUIT:NAME="drugsNotChecked" "DRGNTCK^PSSHRQ23"
;
QUIT:NAME="drugDrugChecks" "DRUGDRUG^PSSHRQ21"
;
QUIT:NAME="drugTherapyChecks" "THERAPY^PSSHRQ22"
;
QUIT:NAME="drugDoseChecks" "DRGDOSE^PSSHRQ23"
QUIT
;
ALTERROR(BASE) ;
; @DESC Handles alternate PEPS errors like being unable to
; connect to PEPS. Reads info from global in format
;
; ^TMP($JOB,"OUT","EXCEPTION")=MESSAGE
;
; @BASE Base of global to be written to
;
; @RETURNS Nothing
;
SET ^TMP($JOB,BASE,"OUT",0)="-1^Vendor Database cannot be reached."
;
; Cleanup the out.exception global
KILL ^TMP($JOB,"OUT","EXCEPTION")
QUIT
;
ERREAD(DOCHAND,HASH) ;
; @DESC Handles parsing the exception XML element and storing it
; in a hash variable
;
; @DOCHAND Handle to XML document
; @HASH ByRef, Hash variable used to store error info
;
; @RETURNS Nothing. Info stored in HASH param.
;
NEW PSS
;
SET PSS("child")=0
;
; Get next child of root element
FOR SET PSS("child")=$$CHILD^MXMLDOM(DOCHAND,1,PSS("child")) QUIT:PSS("child")=0 DO
. SET PSS("childName")=$$NAME^MXMLDOM(DOCHAND,PSS("child"))
. SET:PSS("childName")="code" HASH("code")=$$GETTEXT^PSSHRCOM(DOCHAND,PSS("child"))
. SET:PSS("childName")="message" HASH("message")=$$GETTEXT^PSSHRCOM(DOCHAND,PSS("child"))
QUIT
;
;
CLEXP ;Delete Profile drug exceptions for CPRS if all Prospective drugs have exceptions
N PSSPEX1,PSSPEX2,PSSPEXDL
I '$D(^TMP($J,PSSRBASE,"IN","DRUGDRUG")),'$D(^TMP($J,PSSRBASE,"IN","THERAPY")) Q
I '$D(^TMP($J,PSSRBASE,"OUT","EXCEPTIONS")) Q
S PSSPEXDL=0
S PSSPEX1="" F S PSSPEX1=$O(^TMP($J,PSSRBASE,"IN","PROSPECTIVE",PSSPEX1)) Q:PSSPEX1=""!(PSSPEXDL) D
.I '$D(^TMP($J,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX1)) S PSSPEXDL=1
I PSSPEXDL D CLPAR Q
S PSSPEX2="" F S PSSPEX2=$O(^TMP($J,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX2)) Q:PSSPEX2="" D
.I $P(PSSPEX2,";",3)="PROFILE" K ^TMP($J,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX2)
Q
;
;
CLPAR ;Some Exceptions exist, but not all prospective drugs have an exception
N PSSPEX3,PSSPEX4,PSSPEX5,PSSPEX6,PSSPEX7,PSSPEX8,PSSPEXAR
S PSSPEX3="" F S PSSPEX3=$O(^TMP($J,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX3)) Q:PSSPEX3="" D:$P(PSSPEX3,";",3)="PROSPECTIVE"
.S PSSPEX4="" F S PSSPEX4=$O(^TMP($J,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX3,PSSPEX4)) Q:PSSPEX4="" D
..S PSSPEX5=$P($G(^TMP($J,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX3,PSSPEX4)),"^",3) I PSSPEX5 S PSSPEXAR(PSSPEX5)=""
S PSSPEX6="" F S PSSPEX6=$O(^TMP($J,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX6)) Q:PSSPEX6="" D:$P(PSSPEX6,";",3)="PROFILE"
.S PSSPEX7="" F S PSSPEX7=$O(^TMP($J,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX6,PSSPEX7)) Q:PSSPEX7="" D
..S PSSPEX8=$P($G(^TMP($J,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX6,PSSPEX7)),"^",3) I PSSPEX8,$D(PSSPEXAR(PSSPEX8)) D
...K ^TMP($J,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX6)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSHRQ2O 7117 printed Mar 13, 2025@21:36:28 Page 2
PSSHRQ2O ;WOIFO/AV,TS,SG - Handles parsing a PEPS Drug Check Response ;09/20/07
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**136,160**;9/30/97;Build 76
+2 ;
+3 ; @authors - Chris Flegel, Alex Vazquez, Tim Sabat
+4 ; @date - September 19, 2007
+5 ; @version - 1.0
+6 ;
+7 QUIT
+8 ;;
OUT(DOCHAND,BASE) ;
+1 ; @DESC Parses the PEPSResponse XML and stores in object
+2 ;
+3 ; @DOCHAND Handle to XML document
+4 ; @BASE Base of output global
+5 ;
+6 NEW PSS,HASH,MESSAGE
+7 ;
+8 SET PSS("rootName")=$$NAME^MXMLDOM(DOCHAND,1)
+9 ;
+10 IF PSS("rootName")="exception"
Begin DoDot:1
+11 ; Read error into hash variable
+12 DO ERREAD(DOCHAND,.HASH)
+13 ; Write hashed variable to output global
+14 ; HASH("message")
IF HASH("code")="FDBUPDATE"
SET MESSAGE="Vendor database updates are being processed."
+15 IF '$TEST
IF $DATA(^TMP($JOB,BASE,"IN","DOSE"))>0
SET MESSAGE="An unexpected error has occurred."
+16 IF '$TEST
SET MESSAGE="An unexpected error has occurred."
+17 SET ^TMP($JOB,BASE,"OUT",0)="-1^"_MESSAGE
+18 ;
+19 ; Cleanup the out.exception global
+20 KILL ^TMP($JOB,"OUT","EXCEPTION")
End DoDot:1
+21 ;
+22 IF PSS("rootName")="PEPSResponse"
DO HNDLCK(DOCHAND,BASE)
+23 ;
+24 ; Clean up after using the handle
+25 DO DELETE^MXMLDOM(DOCHAND)
+26 KILL ^TMP($JOB,"OUT XML")
+27 QUIT
+28 ;
HNDLCK(DOCHAND,BASE) ;
+1 ; @DESC This handles the parsing of the PEPSResponse XML element
+2 ;
+3 ; @DOCHAND Handle to XML document
+4 ; @BASE Base of output global
+5 ;
+6 ; @RETURNS Nothing
+7 ;
+8 NEW PSS
+9 ;
+10 ; if ping get the vendor database info and exit.
+11 IF $DATA(^TMP($JOB,BASE,"IN","PING"))
SET ^TMP($JOB,BASE,"OUT",0)=0
DO GTDBINFO(DOCHAND,BASE)
QUIT
+12 ;
+13 ; Get handle to drugCheck XML element
+14 SET PSS("drugCheck")=$$GTHANDLE(DOCHAND)
+15 SET PSS("child")=0
+16 ; Loop through elements of drugCheck
+17 FOR
SET PSS("child")=$$CHILD^MXMLDOM(DOCHAND,PSS("drugCheck"),PSS("child"))
if PSS("child")=0
QUIT
Begin DoDot:1
+18 SET PSS("childName")=$$NAME^MXMLDOM(DOCHAND,PSS("child"))
+19 ;
+20 ; Build executable string
+21 SET PSS("tag")=$$SELTAG(PSS("childName"))
+22 SET PSS("executable")="DO "_PSS("tag")_"(DOCHAND,PSS(""child""),BASE)"
+23 ;
+24 XECUTE PSS("executable")
+25 QUIT
End DoDot:1
+26 ;
+27 ; Set top level node to 1 or 0
+28 IF $DATA(^TMP($JOB,BASE,"OUT"))>1
SET ^TMP($JOB,BASE,"OUT",0)=1
+29 IF $DATA(^TMP($JOB,BASE,"OUT"))<10
SET ^TMP($JOB,BASE,"OUT",0)=0
+30 QUIT
+31 ;
GTDBINFO(DOCHAND,BASE) ; get the Vendor database info.
+1 ; @DOCHAND Handle to XML document
+2 ; @BASE Base of output global
+3 ;
+4 NEW PSS,HEADER
+5 SET PSS("child")=0
+6 SET PSS("childName")=""
+7 ; get <Header> child
+8 FOR
Begin DoDot:1
+9 SET PSS("child")=$$CHILD^MXMLDOM(DOCHAND,1,PSS("child"))
+10 SET PSS("childName")=$$NAME^MXMLDOM(DOCHAND,PSS("child"))
End DoDot:1
if PSS("childName")="Header"
QUIT
+11 ;
+12 ; get <PEPSVersion> child of <Header> element
+13 SET HEADER=PSS("child")
+14 SET PSS("child")=0
+15 FOR
Begin DoDot:1
+16 SET PSS("child")=$$CHILD^MXMLDOM(DOCHAND,HEADER,PSS("child"))
+17 SET PSS("childName")=$$NAME^MXMLDOM(DOCHAND,PSS("child"))
End DoDot:1
if PSS("childName")="PEPSVersion"
QUIT
+18 ;
+19 SET ^TMP($JOB,BASE,"OUT","difIssueDate")=$$VALUE^MXMLDOM(DOCHAND,PSS("child"),"difIssueDate")
+20 SET ^TMP($JOB,BASE,"OUT","difBuildVersion")=$$VALUE^MXMLDOM(DOCHAND,PSS("child"),"difBuildVersion")
+21 SET ^TMP($JOB,BASE,"OUT","difDbVersion")=$$VALUE^MXMLDOM(DOCHAND,PSS("child"),"difDbVersion")
+22 SET ^TMP($JOB,BASE,"OUT","customIssueDate")=$$VALUE^MXMLDOM(DOCHAND,PSS("child"),"customIssueDate")
+23 SET ^TMP($JOB,BASE,"OUT","customBuildVersion")=$$VALUE^MXMLDOM(DOCHAND,PSS("child"),"customBuildVersion")
+24 SET ^TMP($JOB,BASE,"OUT","customDbVersion")=$$VALUE^MXMLDOM(DOCHAND,PSS("child"),"customDbVersion")
+25 QUIT
+26 ;
GTHANDLE(DOCHAND) ;
+1 ; @DESC Get handle to drugCheck element from PEPSResponse element
+2 ;
+3 ; @DOCHAND Handle to XML document
+4 ;
+5 ; @RETURNS Handle to drugCheck XML element
+6 ;
+7 NEW PSS
+8 ;
+9 SET PSS("child")=0
+10 ;
+11 ; Get next child of root element
+12 FOR
SET PSS("child")=$$CHILD^MXMLDOM(DOCHAND,1,PSS("child"))
if PSS("child")=0
QUIT
Begin DoDot:1
+13 SET PSS("childName")=$$NAME^MXMLDOM(DOCHAND,PSS("child"))
+14 if PSS("childName")="Body"
SET PSS("drugCheckElement")=$$CHILD^MXMLDOM(DOCHAND,PSS("child"))
End DoDot:1
+15 ;
+16 QUIT PSS("drugCheckElement")
+17 ;
SELTAG(NAME) ;
+1 ; @DESC Returns the appropriate tag to handle the XML element
+2 ;
+3 ; @NAME Name of the current XML element
+4 ;
+5 ; @RETURNS Returns the appropriate tag to handle the XML element
+6 ;
+7 if NAME="drugsNotChecked"
QUIT "DRGNTCK^PSSHRQ23"
+8 ;
+9 if NAME="drugDrugChecks"
QUIT "DRUGDRUG^PSSHRQ21"
+10 ;
+11 if NAME="drugTherapyChecks"
QUIT "THERAPY^PSSHRQ22"
+12 ;
+13 if NAME="drugDoseChecks"
QUIT "DRGDOSE^PSSHRQ23"
+14 QUIT
+15 ;
ALTERROR(BASE) ;
+1 ; @DESC Handles alternate PEPS errors like being unable to
+2 ; connect to PEPS. Reads info from global in format
+3 ;
+4 ; ^TMP($JOB,"OUT","EXCEPTION")=MESSAGE
+5 ;
+6 ; @BASE Base of global to be written to
+7 ;
+8 ; @RETURNS Nothing
+9 ;
+10 SET ^TMP($JOB,BASE,"OUT",0)="-1^Vendor Database cannot be reached."
+11 ;
+12 ; Cleanup the out.exception global
+13 KILL ^TMP($JOB,"OUT","EXCEPTION")
+14 QUIT
+15 ;
ERREAD(DOCHAND,HASH) ;
+1 ; @DESC Handles parsing the exception XML element and storing it
+2 ; in a hash variable
+3 ;
+4 ; @DOCHAND Handle to XML document
+5 ; @HASH ByRef, Hash variable used to store error info
+6 ;
+7 ; @RETURNS Nothing. Info stored in HASH param.
+8 ;
+9 NEW PSS
+10 ;
+11 SET PSS("child")=0
+12 ;
+13 ; Get next child of root element
+14 FOR
SET PSS("child")=$$CHILD^MXMLDOM(DOCHAND,1,PSS("child"))
if PSS("child")=0
QUIT
Begin DoDot:1
+15 SET PSS("childName")=$$NAME^MXMLDOM(DOCHAND,PSS("child"))
+16 if PSS("childName")="code"
SET HASH("code")=$$GETTEXT^PSSHRCOM(DOCHAND,PSS("child"))
+17 if PSS("childName")="message"
SET HASH("message")=$$GETTEXT^PSSHRCOM(DOCHAND,PSS("child"))
End DoDot:1
+18 QUIT
+19 ;
+20 ;
CLEXP ;Delete Profile drug exceptions for CPRS if all Prospective drugs have exceptions
+1 NEW PSSPEX1,PSSPEX2,PSSPEXDL
+2 IF '$DATA(^TMP($JOB,PSSRBASE,"IN","DRUGDRUG"))
IF '$DATA(^TMP($JOB,PSSRBASE,"IN","THERAPY"))
QUIT
+3 IF '$DATA(^TMP($JOB,PSSRBASE,"OUT","EXCEPTIONS"))
QUIT
+4 SET PSSPEXDL=0
+5 SET PSSPEX1=""
FOR
SET PSSPEX1=$ORDER(^TMP($JOB,PSSRBASE,"IN","PROSPECTIVE",PSSPEX1))
if PSSPEX1=""!(PSSPEXDL)
QUIT
Begin DoDot:1
+6 IF '$DATA(^TMP($JOB,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX1))
SET PSSPEXDL=1
End DoDot:1
+7 IF PSSPEXDL
DO CLPAR
QUIT
+8 SET PSSPEX2=""
FOR
SET PSSPEX2=$ORDER(^TMP($JOB,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX2))
if PSSPEX2=""
QUIT
Begin DoDot:1
+9 IF $PIECE(PSSPEX2,";",3)="PROFILE"
KILL ^TMP($JOB,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX2)
End DoDot:1
+10 QUIT
+11 ;
+12 ;
CLPAR ;Some Exceptions exist, but not all prospective drugs have an exception
+1 NEW PSSPEX3,PSSPEX4,PSSPEX5,PSSPEX6,PSSPEX7,PSSPEX8,PSSPEXAR
+2 SET PSSPEX3=""
FOR
SET PSSPEX3=$ORDER(^TMP($JOB,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX3))
if PSSPEX3=""
QUIT
if $PIECE(PSSPEX3,";",3)="PROSPECTIVE"
Begin DoDot:1
+3 SET PSSPEX4=""
FOR
SET PSSPEX4=$ORDER(^TMP($JOB,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX3,PSSPEX4))
if PSSPEX4=""
QUIT
Begin DoDot:2
+4 SET PSSPEX5=$PIECE($GET(^TMP($JOB,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX3,PSSPEX4)),"^",3)
IF PSSPEX5
SET PSSPEXAR(PSSPEX5)=""
End DoDot:2
End DoDot:1
+5 SET PSSPEX6=""
FOR
SET PSSPEX6=$ORDER(^TMP($JOB,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX6))
if PSSPEX6=""
QUIT
if $PIECE(PSSPEX6,";",3)="PROFILE"
Begin DoDot:1
+6 SET PSSPEX7=""
FOR
SET PSSPEX7=$ORDER(^TMP($JOB,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX6,PSSPEX7))
if PSSPEX7=""
QUIT
Begin DoDot:2
+7 SET PSSPEX8=$PIECE($GET(^TMP($JOB,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX6,PSSPEX7)),"^",3)
IF PSSPEX8
IF $DATA(PSSPEXAR(PSSPEX8))
Begin DoDot:3
+8 KILL ^TMP($JOB,PSSRBASE,"OUT","EXCEPTIONS",PSSPEX6)
End DoDot:3
End DoDot:2
End DoDot:1
+9 QUIT
