PSSHRQ21 ;WOIFO/AV,TS - Parses a PEPS drugDrugChecks XML element ; 08 Jun 2016 5:49 PM
;;1.0;PHARMACY DATA MANAGEMENT;**136,160,184**;9/30/97;Build 14
;
; @authors - Alex Vazquez, Tim Sabat
; @date - September 19, 2007
; @version - 1.0
;
QUIT
;;
DRUGDRUG(DOCHAND,NODE,BASE) ;
; @DESC Handles putting the drugDrugChecks XML element into
; the DrugOrderChecks object
;
; @DOCHAND Handle to XML document
; @NODE Node associated with XML element
; @PSSHAND Handle to DrugOrderChecks object
;
; @RETURNS Nothing
NEW PSS,MSGHASH,DRUGHASH,PSMSGCNT
;
SET PSS("child")=0
SET PSS("drugCount")=0
SET PSMSGCNT=0
;
FOR SET PSS("child")=$$CHILD^MXMLDOM(DOCHAND,NODE,PSS("child")) QUIT:PSS("child")=0 DO
. SET PSS("childName")=$$NAME^MXMLDOM(DOCHAND,PSS("child"))
. ;xml can have message at the top level of drugDrugCheck as well as within drugDrugChecks
. SET:PSS("childName")="message" PSMSGCNT=PSMSGCNT+1
. DO:PSS("childName")="message" MSGREAD(DOCHAND,PSS("child"),.MSGHASH,PSMSGCNT)
. ;
. SET:PSS("childName")="drugDrugCheck" PSS("drugCount")=PSS("drugCount")+1
. DO:PSS("childName")="drugDrugCheck" DRUGREAD(DOCHAND,PSS("child"),.DRUGHASH,PSS("drugCount"),.MSGHASH,PSMSGCNT)
. QUIT
;
; Write to globals
; MSGHASH is populated within DRUGREAD if a message exists
DO MSGWRITE(.MSGHASH,BASE,"DRUGDRUG")
DO DRUGWRIT(.DRUGHASH,BASE)
QUIT
;;
MSGREAD(DOCHAND,NODE,HASH,COUNT) ;
; @DESC Handles parsing message section
;
; @DOCHAND Handle to XML document
; @NODE Node associated with XML element
; @COUNT Count of message sections
; @HASH Where to store info
;
; @RETURNS Nothing
;
; Parse the message and store in hash
DO PARSEMSG^PSSHRCOM(DOCHAND,NODE,.HASH,COUNT)
;
QUIT
;;
MSGWRITE(HASH,BASE,SUB) ;
; @DESC Handles writing message section of the XML document
; @NOTE:Error nodes for drugsnotchecked and for drug dosing messages are set
; in PSSHRQ23
; @HASH ByRef, Hash used to store response
; @BASE Base of output global
; @SUB Type of message --DRUGDRUG, THERAPY OR DOSE
; @RETURNS Nothing. Stores values in output global.
NEW PSS,I,NODE,WARNFLG,NODECNT
;
SET I=""
FOR SET I=$ORDER(HASH(I)) QUIT:I="" DO
. ; Create the node to be used with subscript indirection
. ;
. SET NODE="^TMP($JOB,BASE,""OUT"",SUB,""ERROR"",HASH(I,""orderNumber""))"
. ;gets next error number
. S NODECNT=$O(@NODE@(":"),-1)+1
. SET NODE="^TMP($JOB,BASE,""OUT"",SUB,""ERROR"",HASH(I,""orderNumber""),NODECNT)"
. ;Need to $G several hash entries because they are undefined coming from NOTWRITE^PSSHRQ23
. I $G(HASH(I,"severity"))="Information" Q ;If severity="information" don't save
. SET @NODE@(0)=HASH(I,"drugName")_"^"_HASH(I,"ien")_"^"_HASH(I,"cprsOrderNumber")_"^"_HASH(I,"package")
. SET @NODE@("SEV")=$G(HASH(I,"severity"))
. SET @NODE@("TYPE")=$G(HASH(I,"type"))
. ;SET @NODE@("NAME")=HASH(I,"drugName")
. SET @NODE@("TEXT")=HASH(I,"text")
. S WARNFLG=$S($G(HASH(I,"severity"))="Warning":1,1:0)
. ;Message node to display to user
. S @NODE@("MSG")=$$ERRMSG^PSSHRVL1(SUB,HASH(I,"drugName"),HASH(I,"orderNumber"),WARNFLG)
. ;D
. ;.I $D(HASH(I,"msg")) S @NODE@("MSG")=HASH(I,"msg") Q
. ;.S @NODE@("MSG")=$$ERRMSG^PSSHRVL1(SUB,HASH(I,"drugName"),HASH(I,"orderNumber"),WARNFLG)
. QUIT
QUIT
;;
DRUGREAD(DOCHAND,NODE,HASH,COUNT,MSGHASH,MSGCNT) ;
; @DESC Handles parsing and storage of drugDrugCheck element
;
; @DOCHAND Handle to XML document
; @NODE Node associated with XML element
; @COUNT Count of message sections
; @HASH Where to store info (by ref)
; @MSGHASH-Where message information is stored (by ref)
; @MSGCNT-counter for messages
;
; @RETURNS Nothing
NEW PSS
;
SET PSS("child")=0
;
SET PSS("messageCount")=MSGCNT
;
FOR SET PSS("child")=$$CHILD^MXMLDOM(DOCHAND,NODE,PSS("child")) QUIT:PSS("child")=0 DO
. SET PSS("childName")=$$NAME^MXMLDOM(DOCHAND,PSS("child"))
. ;
. I PSS("childName")="message" D Q
. .S PSS("messageCount")=PSS("messageCount")+1
. .D MSGREAD(DOCHAND,PSS("child"),.MSGHASH,PSS("messageCount"))
. ;
. DO:PSS("childName")="interactedDrugList"
. . DO DRUGLIST^PSSHRCOM(DOCHAND,PSS("child"),.HASH,COUNT)
. . QUIT
. DO:PSS("childName")="severity"
. . ; Translate the peps severity into a vista specific severity
. . SET HASH(COUNT,"severity")=$$TRANSEV($$GETTEXT^PSSHRCOM(DOCHAND,PSS("child")))
. . QUIT
. DO:PSS("childName")="interaction"
. . SET HASH(COUNT,"interaction")=$$GETTEXT^PSSHRCOM(DOCHAND,PSS("child"))
. . QUIT
. DO:PSS("childName")="shortText"
. . SET HASH(COUNT,"shortText")=$$GETTEXT^PSSHRCOM(DOCHAND,PSS("child"))
. . QUIT
. DO:PSS("childName")="professionalMonograph"
. . DO MONOGRAF(DOCHAND,PSS("child"),.HASH,"ProfessionalMonograph",COUNT)
. . QUIT
. DO:PSS("childName")="consumerMonograph"
. . DO MONOGRAF(DOCHAND,PSS("child"),.HASH,"ConsumerMonograph",COUNT)
. . QUIT
. QUIT
QUIT
;;
MONOGRAF(DOCHAND,NODE,HASH,MONOTYPE,COUNT) ;
; @DESC Parses and stores the monograph of the monograph type
;
; @DOCHAND Handle to XML document
; @NODE Node associated with XML element
; @HASH Handle to DrugOrderChecks object
; @MONOTYPE Type of monograph either ProfessionalMonograph or ConsumerMonograph
;
; @RETURNS Nothing
;
NEW PSS
;
SET PSS("child")=0
SET PSS("i")=0
;
FOR SET PSS("child")=$$CHILD^MXMLDOM(DOCHAND,NODE,PSS("child")) QUIT:PSS("child")=0 DO
. ; Get the sub elements of the monograph type section
. SET PSS("childName")=$$NAME^MXMLDOM(DOCHAND,PSS("child"))
. I PSS("childName")="monographSource" D Q
. .S HASH(COUNT,"monographSource")=$$GETTEXT^PSSHRCOM(DOCHAND,PSS("child"))
. SET PSS("i")=PSS("i")+1
.
. ;if this is references element get reference sub-element.
. I PSS("childName")="references" D Q
. . D REF(DOCHAND,PSS("child"),.HASH,MONOTYPE,COUNT)
. ; Get text of element
. SET PSS("sectionText")=$$GETTEXT^PSSHRCOM(DOCHAND,PSS("child"))
. SET HASH(COUNT,MONOTYPE,PSS("childName"))=PSS("sectionText")
. QUIT
;
; Set the total count of monograph sections
SET HASH(COUNT,MONOTYPE,0)=PSS("i")
;
QUIT
;;
REF(DOCHAND,NODE,HASH,MONOTYPE,COUNT) ;
; @DESC Parses and stores the reference element of references element.
;
; @DOCHAND Handle to XML document
; @NODE Node associated with XML element
; @HASH Handle to DrugOrderChecks object
; @MONOTYPE Type of monograph either ProfessionalMonograph or ConsumerMonograph
;
; @RETURNS Nothing
;
NEW PSS
;
SET PSS("child")=0
SET PSS("i")=0
;
FOR SET PSS("child")=$$CHILD^MXMLDOM(DOCHAND,NODE,PSS("child")) QUIT:PSS("child")=0 DO
. ; Get the sub elements of the references type section
. SET PSS("childName")=$$NAME^MXMLDOM(DOCHAND,PSS("child"))
. I PSS("childName")="reference" D
. .S HASH(COUNT,MONOTYPE,"references",PSS("i"))=$$GETTEXT^PSSHRCOM(DOCHAND,PSS("child"))
. .SET PSS("i")=PSS("i")+1
. QUIT
S:PSS("i")>0 HASH(COUNT,MONOTYPE,"references")=PSS("i") ; if >0 means references have reference elements
QUIT
;;
DRUGWRIT(HASH,BASE) ;
; @DESC Handles writing drugDrugChecks drugDrugCheck section of the XML document
;
; @HASH ByRef, Hash used to store response
; @BASE Base of output global
;
; @RETURNS Nothing. Stores values in output global.
;
NEW I,PSS,NODE,FIRST,SECOND,SUB,IPMON,L,PSSCLIN,PSSDRGNM,PSSCHK
SET SUB="ProfessionalMonograph"
;
; Loop through the drugDrugCheck elements
SET I=""
FOR SET I=$ORDER(HASH(I)) QUIT:I="" DO
. ; If Severity equals 0 ignore this drug drug check and move onto next
. IF +HASH(I,"severity")=-1 QUIT
. S IPMON=16 ; PMON index before starting to write references
. ; A profile drug should always take precedent in the subscript over a prospective drug
. ; If two prospective or two profile drugs then precedence doesn't matter
. ; Set the values to default values
. SET FIRST=1
. SET SECOND=2
. IF $$ISPROF^PSSHRCOM(HASH(I,"drugList",2,"orderNumber"))=1 DO
. . SET FIRST=2
. . SET SECOND=1
. . QUIT
. ;
. ; Create the node to use with subscript indirection
. SET NODE="^TMP($JOB,BASE,""OUT"",""DRUGDRUG"",$$SEVCODE(HASH(I,""severity""))"
. SET NODE=NODE_",HASH(I,""drugList"",FIRST,""drugName""),HASH(I,""drugList"",FIRST,""orderNumber""),I)"
.
. ; Value on right of = should be as follows
. ; 2nd Order Number^2nd Drug IEN^1st Drug IEN^2nd Drug Name^CPRS Order Number^Package
. SET PSS("value")=HASH(I,"drugList",SECOND,"orderNumber")_"^"_HASH(I,"drugList",SECOND,"ien")_"^"_HASH(I,"drugList",FIRST,"ien")
. SET PSS("value")=PSS("value")_"^"_HASH(I,"drugList",SECOND,"drugName")_"^"_HASH(I,"drugList",FIRST,"cprsOrderNumber")_"^"_HASH(I,"drugList",FIRST,"package")
. SET @NODE=PSS("value")
. ;
. I $$CHKHASH(.HASH,I,"severity") SET @NODE@("SEV")=HASH(I,"severity")
. I $$CHKHASH(.HASH,I,"shortText") SET @NODE@("SHORT")=HASH(I,"shortText")
. I $$CHKHASH(.HASH,I,"interaction") SET @NODE@("INT")=HASH(I,"interaction")
. I $$CHKHASH(.HASH,I,SUB,"clinicalEffects") D
. . ;prevent string length error due to message being duplicated when same drug ordered multiple times
. . S PSSCLIN=HASH(I,"ProfessionalMonograph","clinicalEffects")
. . S PSSDRGNM=HASH(I,"drugList",FIRST,"drugName")
. . Q:PSSDRGNM=""!(PSSCLIN="")
. . ;Do not repeat text if drug is ordered multiple times
. . Q:$D(PSSCHK(PSSDRGNM,$E(PSSCLIN,1,500)))
. . ;save text for drug if being checked again in this session
. . S PSSCHK(PSSDRGNM,$E(PSSCLIN,1,500))=""
. . S @NODE@("CLIN")=HASH(I,"ProfessionalMonograph","clinicalEffects")
. ;
. ; Write professional monograph
. ; Professional monograph MUST be in order specified by code with a single
. ; line of space between each section
. I $$CHKHASH(.HASH,I,SUB,0) SET @NODE@("PMON")=HASH(I,"ProfessionalMonograph",0)
. I $$CHKHASH(.HASH,I,SUB,"disclaimer") D
. .SET @NODE@("PMON",1,0)=HASH(I,"ProfessionalMonograph","disclaimer")
. .SET @NODE@("PMON",2,0)=""
. I $$CHKHASH(.HASH,I,SUB,"monographTitle") D
. .SET @NODE@("PMON",3,0)=HASH(I,"ProfessionalMonograph","monographTitle")
. .SET @NODE@("PMON",4,0)=""
. I $$CHKHASH(.HASH,I,SUB,"severityLevel") D
. .SET @NODE@("PMON",5,0)=HASH(I,"ProfessionalMonograph","severityLevel")
. .SET @NODE@("PMON",6,0)=""
. I $$CHKHASH(.HASH,I,SUB,"mechanismOfAction") D
. .SET @NODE@("PMON",7,0)=HASH(I,"ProfessionalMonograph","mechanismOfAction")
. .SET @NODE@("PMON",8,0)=""
. I $$CHKHASH(.HASH,I,SUB,"clinicalEffects") D
. .SET @NODE@("PMON",9,0)=HASH(I,"ProfessionalMonograph","clinicalEffects")
. .SET @NODE@("PMON",10,0)=""
. I $$CHKHASH(.HASH,I,SUB,"predisposingFactors") D
. .SET @NODE@("PMON",11,0)=HASH(I,"ProfessionalMonograph","predisposingFactors")
. .SET @NODE@("PMON",12,0)=""
. I $$CHKHASH(.HASH,I,SUB,"patientManagement") D
. .SET @NODE@("PMON",13,0)=HASH(I,"ProfessionalMonograph","patientManagement")
. .SET @NODE@("PMON",14,0)=""
. I $$CHKHASH(.HASH,I,SUB,"discussion") D
. .SET @NODE@("PMON",15,0)=HASH(I,"ProfessionalMonograph","discussion")
. .SET @NODE@("PMON",16,0)=""
. I $$CHKHASH(.HASH,I,SUB,"references") D
. . S L=""
. . F S L=$O(HASH(I,"ProfessionalMonograph","references",L)) Q:L="" D
. . .S IPMON=IPMON+1
. . .S @NODE@("PMON",IPMON,0)=HASH(I,"ProfessionalMonograph","references",L)
. . ;
. . S IPMON=IPMON+1
. . SET @NODE@("PMON",IPMON,0)=""
. ;
. I $$CHKHASH(.HASH,I,"monographSource") SET IPMON=IPMON+1 SET @NODE@("PMON",IPMON,0)=$$COPYRITE(HASH(I,"monographSource"))
. ;
. ; Write consumer monograph
. ; consumer monograph NOT currently available TODO add when available
. QUIT
K PSSCLIN,PSSDRGNM,PSSCHK
QUIT
;;
CHKHASH(HASH,CNT,SUB1,SUB2) ;
;CHECKS if hash node has data
;inputs: HASH-ARRAY PASSED IN BY REF
; CNT-The hash number passed in
; SUB1--First subscript
; SUB2 (OPTIONAL)-SECOND SUBSCRIPT
;RETURNS LENGTH OF DATA IN NODE OR 0 IF DOESN'T EXIST
N RESULT
D
.I $L($G(SUB2)) D Q
..S RESULT=$L($G(HASH(CNT,SUB1,SUB2)))
.S RESULT=$L($G(HASH(CNT,SUB1)))
Q RESULT
;
TRANSEV(SEV) ;
; @DESC Translates the severity attribute returned by the XML into
; a VistA specific severity
;
; @SEV Severity returned from the XML
;
; @RETURNS VistA specific severity
;
; DrugDrugChecks with an FDB severity of "Contraindicated Drug Combination"
; will be displayed as "Critical".
; DrugDrugChecks with an FDB severity of "Severe Interaction" will be displayed as "Significant".
; IMPORTANT:
; DrugDrugChecks that are not 'critical' or 'significant' are not included in output global.
QUIT $SELECT(SEV="Contraindicated Drug Combination":"Critical",SEV="Severe Interaction":"Significant",1:-1)
;;
SEVCODE(SEV) ;
; @DESC Returns the proper severity code depending on the VistA specific severity
;
; @SEV VistA specific severity.
;
; @RETURNS Returns severity code. 'C' for Critical. 'S' for Significant.
;
QUIT $SELECT(SEV="Critical":"C",SEV="Significant":"S")
;;
COPYRITE(SOURCE) ;
; @DESC Returns correct copyright disclaimer for FDB OR VA PBM in format
; @Copyright [Current Year] First DataBank, Inc.
; @Information provided by VA PBM-SHG
; @INPUT: source FDB OR Custom
; @RETURNS FDB copyright OR va pbm information
;
NEW PSS
;
N %I
DO NOW^%DTC
SET PSS("fileManYear")=%I(3)
; File man years begin at 1700
SET PSS("year")=PSS("fileManYear")+1700
;
D ;Case on Source
.I SOURCE="Custom" S PSS("source")="Information provided by VA PBM-SHG" Q
.S PSS("source")="Copyright "_PSS("year")_" First Databank, Inc."
QUIT PSS("source")
;;
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSHRQ21 13649 printed Sep 23, 2025@20:07:35 Page 2
PSSHRQ21 ;WOIFO/AV,TS - Parses a PEPS drugDrugChecks XML element ; 08 Jun 2016 5:49 PM
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**136,160,184**;9/30/97;Build 14
+2 ;
+3 ; @authors - Alex Vazquez, Tim Sabat
+4 ; @date - September 19, 2007
+5 ; @version - 1.0
+6 ;
+7 QUIT
+8 ;;
DRUGDRUG(DOCHAND,NODE,BASE) ;
+1 ; @DESC Handles putting the drugDrugChecks XML element into
+2 ; the DrugOrderChecks object
+3 ;
+4 ; @DOCHAND Handle to XML document
+5 ; @NODE Node associated with XML element
+6 ; @PSSHAND Handle to DrugOrderChecks object
+7 ;
+8 ; @RETURNS Nothing
+9 NEW PSS,MSGHASH,DRUGHASH,PSMSGCNT
+10 ;
+11 SET PSS("child")=0
+12 SET PSS("drugCount")=0
+13 SET PSMSGCNT=0
+14 ;
+15 FOR
SET PSS("child")=$$CHILD^MXMLDOM(DOCHAND,NODE,PSS("child"))
if PSS("child")=0
QUIT
Begin DoDot:1
+16 SET PSS("childName")=$$NAME^MXMLDOM(DOCHAND,PSS("child"))
+17 ;xml can have message at the top level of drugDrugCheck as well as within drugDrugChecks
+18 if PSS("childName")="message"
SET PSMSGCNT=PSMSGCNT+1
+19 if PSS("childName")="message"
DO MSGREAD(DOCHAND,PSS("child"),.MSGHASH,PSMSGCNT)
+20 ;
+21 if PSS("childName")="drugDrugCheck"
SET PSS("drugCount")=PSS("drugCount")+1
+22 if PSS("childName")="drugDrugCheck"
DO DRUGREAD(DOCHAND,PSS("child"),.DRUGHASH,PSS("drugCount"),.MSGHASH,PSMSGCNT)
+23 QUIT
End DoDot:1
+24 ;
+25 ; Write to globals
+26 ; MSGHASH is populated within DRUGREAD if a message exists
+27 DO MSGWRITE(.MSGHASH,BASE,"DRUGDRUG")
+28 DO DRUGWRIT(.DRUGHASH,BASE)
+29 QUIT
+30 ;;
MSGREAD(DOCHAND,NODE,HASH,COUNT) ;
+1 ; @DESC Handles parsing message section
+2 ;
+3 ; @DOCHAND Handle to XML document
+4 ; @NODE Node associated with XML element
+5 ; @COUNT Count of message sections
+6 ; @HASH Where to store info
+7 ;
+8 ; @RETURNS Nothing
+9 ;
+10 ; Parse the message and store in hash
+11 DO PARSEMSG^PSSHRCOM(DOCHAND,NODE,.HASH,COUNT)
+12 ;
+13 QUIT
+14 ;;
MSGWRITE(HASH,BASE,SUB) ;
+1 ; @DESC Handles writing message section of the XML document
+2 ; @NOTE:Error nodes for drugsnotchecked and for drug dosing messages are set
+3 ; in PSSHRQ23
+4 ; @HASH ByRef, Hash used to store response
+5 ; @BASE Base of output global
+6 ; @SUB Type of message --DRUGDRUG, THERAPY OR DOSE
+7 ; @RETURNS Nothing. Stores values in output global.
+8 NEW PSS,I,NODE,WARNFLG,NODECNT
+9 ;
+10 SET I=""
+11 FOR
SET I=$ORDER(HASH(I))
if I=""
QUIT
Begin DoDot:1
+12 ; Create the node to be used with subscript indirection
+13 ;
+14 SET NODE="^TMP($JOB,BASE,""OUT"",SUB,""ERROR"",HASH(I,""orderNumber""))"
+15 ;gets next error number
+16 SET NODECNT=$ORDER(@NODE@(":"),-1)+1
+17 SET NODE="^TMP($JOB,BASE,""OUT"",SUB,""ERROR"",HASH(I,""orderNumber""),NODECNT)"
+18 ;Need to $G several hash entries because they are undefined coming from NOTWRITE^PSSHRQ23
+19 ;If severity="information" don't save
IF $GET(HASH(I,"severity"))="Information"
QUIT
+20 SET @NODE@(0)=HASH(I,"drugName")_"^"_HASH(I,"ien")_"^"_HASH(I,"cprsOrderNumber")_"^"_HASH(I,"package")
+21 SET @NODE@("SEV")=$GET(HASH(I,"severity"))
+22 SET @NODE@("TYPE")=$GET(HASH(I,"type"))
+23 ;SET @NODE@("NAME")=HASH(I,"drugName")
+24 SET @NODE@("TEXT")=HASH(I,"text")
+25 SET WARNFLG=$SELECT($GET(HASH(I,"severity"))="Warning":1,1:0)
+26 ;Message node to display to user
+27 SET @NODE@("MSG")=$$ERRMSG^PSSHRVL1(SUB,HASH(I,"drugName"),HASH(I,"orderNumber"),WARNFLG)
+28 ;D
+29 ;.I $D(HASH(I,"msg")) S @NODE@("MSG")=HASH(I,"msg") Q
+30 ;.S @NODE@("MSG")=$$ERRMSG^PSSHRVL1(SUB,HASH(I,"drugName"),HASH(I,"orderNumber"),WARNFLG)
+31 QUIT
End DoDot:1
+32 QUIT
+33 ;;
DRUGREAD(DOCHAND,NODE,HASH,COUNT,MSGHASH,MSGCNT) ;
+1 ; @DESC Handles parsing and storage of drugDrugCheck element
+2 ;
+3 ; @DOCHAND Handle to XML document
+4 ; @NODE Node associated with XML element
+5 ; @COUNT Count of message sections
+6 ; @HASH Where to store info (by ref)
+7 ; @MSGHASH-Where message information is stored (by ref)
+8 ; @MSGCNT-counter for messages
+9 ;
+10 ; @RETURNS Nothing
+11 NEW PSS
+12 ;
+13 SET PSS("child")=0
+14 ;
+15 SET PSS("messageCount")=MSGCNT
+16 ;
+17 FOR
SET PSS("child")=$$CHILD^MXMLDOM(DOCHAND,NODE,PSS("child"))
if PSS("child")=0
QUIT
Begin DoDot:1
+18 SET PSS("childName")=$$NAME^MXMLDOM(DOCHAND,PSS("child"))
+19 ;
+20 IF PSS("childName")="message"
Begin DoDot:2
+21 SET PSS("messageCount")=PSS("messageCount")+1
+22 DO MSGREAD(DOCHAND,PSS("child"),.MSGHASH,PSS("messageCount"))
End DoDot:2
QUIT
+23 ;
+24 if PSS("childName")="interactedDrugList"
Begin DoDot:2
+25 DO DRUGLIST^PSSHRCOM(DOCHAND,PSS("child"),.HASH,COUNT)
+26 QUIT
End DoDot:2
+27 if PSS("childName")="severity"
Begin DoDot:2
+28 ; Translate the peps severity into a vista specific severity
+29 SET HASH(COUNT,"severity")=$$TRANSEV($$GETTEXT^PSSHRCOM(DOCHAND,PSS("child")))
+30 QUIT
End DoDot:2
+31 if PSS("childName")="interaction"
Begin DoDot:2
+32 SET HASH(COUNT,"interaction")=$$GETTEXT^PSSHRCOM(DOCHAND,PSS("child"))
+33 QUIT
End DoDot:2
+34 if PSS("childName")="shortText"
Begin DoDot:2
+35 SET HASH(COUNT,"shortText")=$$GETTEXT^PSSHRCOM(DOCHAND,PSS("child"))
+36 QUIT
End DoDot:2
+37 if PSS("childName")="professionalMonograph"
Begin DoDot:2
+38 DO MONOGRAF(DOCHAND,PSS("child"),.HASH,"ProfessionalMonograph",COUNT)
+39 QUIT
End DoDot:2
+40 if PSS("childName")="consumerMonograph"
Begin DoDot:2
+41 DO MONOGRAF(DOCHAND,PSS("child"),.HASH,"ConsumerMonograph",COUNT)
+42 QUIT
End DoDot:2
+43 QUIT
End DoDot:1
+44 QUIT
+45 ;;
MONOGRAF(DOCHAND,NODE,HASH,MONOTYPE,COUNT) ;
+1 ; @DESC Parses and stores the monograph of the monograph type
+2 ;
+3 ; @DOCHAND Handle to XML document
+4 ; @NODE Node associated with XML element
+5 ; @HASH Handle to DrugOrderChecks object
+6 ; @MONOTYPE Type of monograph either ProfessionalMonograph or ConsumerMonograph
+7 ;
+8 ; @RETURNS Nothing
+9 ;
+10 NEW PSS
+11 ;
+12 SET PSS("child")=0
+13 SET PSS("i")=0
+14 ;
+15 FOR
SET PSS("child")=$$CHILD^MXMLDOM(DOCHAND,NODE,PSS("child"))
if PSS("child")=0
QUIT
Begin DoDot:1
+16 ; Get the sub elements of the monograph type section
+17 SET PSS("childName")=$$NAME^MXMLDOM(DOCHAND,PSS("child"))
+18 IF PSS("childName")="monographSource"
Begin DoDot:2
+19 SET HASH(COUNT,"monographSource")=$$GETTEXT^PSSHRCOM(DOCHAND,PSS("child"))
End DoDot:2
QUIT
+20 SET PSS("i")=PSS("i")+1
+21 +22 ;if this is references element get reference sub-element.
+23 IF PSS("childName")="references"
Begin DoDot:2
+24 DO REF(DOCHAND,PSS("child"),.HASH,MONOTYPE,COUNT)
End DoDot:2
QUIT
+25 ; Get text of element
+26 SET PSS("sectionText")=$$GETTEXT^PSSHRCOM(DOCHAND,PSS("child"))
+27 SET HASH(COUNT,MONOTYPE,PSS("childName"))=PSS("sectionText")
+28 QUIT
End DoDot:1
+29 ;
+30 ; Set the total count of monograph sections
+31 SET HASH(COUNT,MONOTYPE,0)=PSS("i")
+32 ;
+33 QUIT
+34 ;;
REF(DOCHAND,NODE,HASH,MONOTYPE,COUNT) ;
+1 ; @DESC Parses and stores the reference element of references element.
+2 ;
+3 ; @DOCHAND Handle to XML document
+4 ; @NODE Node associated with XML element
+5 ; @HASH Handle to DrugOrderChecks object
+6 ; @MONOTYPE Type of monograph either ProfessionalMonograph or ConsumerMonograph
+7 ;
+8 ; @RETURNS Nothing
+9 ;
+10 NEW PSS
+11 ;
+12 SET PSS("child")=0
+13 SET PSS("i")=0
+14 ;
+15 FOR
SET PSS("child")=$$CHILD^MXMLDOM(DOCHAND,NODE,PSS("child"))
if PSS("child")=0
QUIT
Begin DoDot:1
+16 ; Get the sub elements of the references type section
+17 SET PSS("childName")=$$NAME^MXMLDOM(DOCHAND,PSS("child"))
+18 IF PSS("childName")="reference"
Begin DoDot:2
+19 SET HASH(COUNT,MONOTYPE,"references",PSS("i"))=$$GETTEXT^PSSHRCOM(DOCHAND,PSS("child"))
+20 SET PSS("i")=PSS("i")+1
End DoDot:2
+21 QUIT
End DoDot:1
+22 ; if >0 means references have reference elements
if PSS("i")>0
SET HASH(COUNT,MONOTYPE,"references")=PSS("i")
+23 QUIT
+24 ;;
DRUGWRIT(HASH,BASE) ;
+1 ; @DESC Handles writing drugDrugChecks drugDrugCheck section of the XML document
+2 ;
+3 ; @HASH ByRef, Hash used to store response
+4 ; @BASE Base of output global
+5 ;
+6 ; @RETURNS Nothing. Stores values in output global.
+7 ;
+8 NEW I,PSS,NODE,FIRST,SECOND,SUB,IPMON,L,PSSCLIN,PSSDRGNM,PSSCHK
+9 SET SUB="ProfessionalMonograph"
+10 ;
+11 ; Loop through the drugDrugCheck elements
+12 SET I=""
+13 FOR
SET I=$ORDER(HASH(I))
if I=""
QUIT
Begin DoDot:1
+14 ; If Severity equals 0 ignore this drug drug check and move onto next
+15 IF +HASH(I,"severity")=-1
QUIT
+16 ; PMON index before starting to write references
SET IPMON=16
+17 ; A profile drug should always take precedent in the subscript over a prospective drug
+18 ; If two prospective or two profile drugs then precedence doesn't matter
+19 ; Set the values to default values
+20 SET FIRST=1
+21 SET SECOND=2
+22 IF $$ISPROF^PSSHRCOM(HASH(I,"drugList",2,"orderNumber"))=1
Begin DoDot:2
+23 SET FIRST=2
+24 SET SECOND=1
+25 QUIT
End DoDot:2
+26 ;
+27 ; Create the node to use with subscript indirection
+28 SET NODE="^TMP($JOB,BASE,""OUT"",""DRUGDRUG"",$$SEVCODE(HASH(I,""severity""))"
+29 SET NODE=NODE_",HASH(I,""drugList"",FIRST,""drugName""),HASH(I,""drugList"",FIRST,""orderNumber""),I)"
+30 +31 ; Value on right of = should be as follows
+32 ; 2nd Order Number^2nd Drug IEN^1st Drug IEN^2nd Drug Name^CPRS Order Number^Package
+33 SET PSS("value")=HASH(I,"drugList",SECOND,"orderNumber")_"^"_HASH(I,"drugList",SECOND,"ien")_"^"_HASH(I,"drugList",FIRST,"ien")
+34 SET PSS("value")=PSS("value")_"^"_HASH(I,"drugList",SECOND,"drugName")_"^"_HASH(I,"drugList",FIRST,"cprsOrderNumber")_"^"_HASH(I,"drugList",FIRST,"package")
+35 SET @NODE=PSS("value")
+36 ;
+37 IF $$CHKHASH(.HASH,I,"severity")
SET @NODE@("SEV")=HASH(I,"severity")
+38 IF $$CHKHASH(.HASH,I,"shortText")
SET @NODE@("SHORT")=HASH(I,"shortText")
+39 IF $$CHKHASH(.HASH,I,"interaction")
SET @NODE@("INT")=HASH(I,"interaction")
+40 IF $$CHKHASH(.HASH,I,SUB,"clinicalEffects")
Begin DoDot:2
+41 ;prevent string length error due to message being duplicated when same drug ordered multiple times
+42 SET PSSCLIN=HASH(I,"ProfessionalMonograph","clinicalEffects")
+43 SET PSSDRGNM=HASH(I,"drugList",FIRST,"drugName")
+44 if PSSDRGNM=""!(PSSCLIN="")
QUIT
+45 ;Do not repeat text if drug is ordered multiple times
+46 if $DATA(PSSCHK(PSSDRGNM,$EXTRACT(PSSCLIN,1,500)))
QUIT
+47 ;save text for drug if being checked again in this session
+48 SET PSSCHK(PSSDRGNM,$EXTRACT(PSSCLIN,1,500))=""
+49 SET @NODE@("CLIN")=HASH(I,"ProfessionalMonograph","clinicalEffects")
End DoDot:2
+50 ;
+51 ; Write professional monograph
+52 ; Professional monograph MUST be in order specified by code with a single
+53 ; line of space between each section
+54 IF $$CHKHASH(.HASH,I,SUB,0)
SET @NODE@("PMON")=HASH(I,"ProfessionalMonograph",0)
+55 IF $$CHKHASH(.HASH,I,SUB,"disclaimer")
Begin DoDot:2
+56 SET @NODE@("PMON",1,0)=HASH(I,"ProfessionalMonograph","disclaimer")
+57 SET @NODE@("PMON",2,0)=""
End DoDot:2
+58 IF $$CHKHASH(.HASH,I,SUB,"monographTitle")
Begin DoDot:2
+59 SET @NODE@("PMON",3,0)=HASH(I,"ProfessionalMonograph","monographTitle")
+60 SET @NODE@("PMON",4,0)=""
End DoDot:2
+61 IF $$CHKHASH(.HASH,I,SUB,"severityLevel")
Begin DoDot:2
+62 SET @NODE@("PMON",5,0)=HASH(I,"ProfessionalMonograph","severityLevel")
+63 SET @NODE@("PMON",6,0)=""
End DoDot:2
+64 IF $$CHKHASH(.HASH,I,SUB,"mechanismOfAction")
Begin DoDot:2
+65 SET @NODE@("PMON",7,0)=HASH(I,"ProfessionalMonograph","mechanismOfAction")
+66 SET @NODE@("PMON",8,0)=""
End DoDot:2
+67 IF $$CHKHASH(.HASH,I,SUB,"clinicalEffects")
Begin DoDot:2
+68 SET @NODE@("PMON",9,0)=HASH(I,"ProfessionalMonograph","clinicalEffects")
+69 SET @NODE@("PMON",10,0)=""
End DoDot:2
+70 IF $$CHKHASH(.HASH,I,SUB,"predisposingFactors")
Begin DoDot:2
+71 SET @NODE@("PMON",11,0)=HASH(I,"ProfessionalMonograph","predisposingFactors")
+72 SET @NODE@("PMON",12,0)=""
End DoDot:2
+73 IF $$CHKHASH(.HASH,I,SUB,"patientManagement")
Begin DoDot:2
+74 SET @NODE@("PMON",13,0)=HASH(I,"ProfessionalMonograph","patientManagement")
+75 SET @NODE@("PMON",14,0)=""
End DoDot:2
+76 IF $$CHKHASH(.HASH,I,SUB,"discussion")
Begin DoDot:2
+77 SET @NODE@("PMON",15,0)=HASH(I,"ProfessionalMonograph","discussion")
+78 SET @NODE@("PMON",16,0)=""
End DoDot:2
+79 IF $$CHKHASH(.HASH,I,SUB,"references")
Begin DoDot:2
+80 SET L=""
+81 FOR
SET L=$ORDER(HASH(I,"ProfessionalMonograph","references",L))
if L=""
QUIT
Begin DoDot:3
+82 SET IPMON=IPMON+1
+83 SET @NODE@("PMON",IPMON,0)=HASH(I,"ProfessionalMonograph","references",L)
End DoDot:3
+84 ;
+85 SET IPMON=IPMON+1
+86 SET @NODE@("PMON",IPMON,0)=""
End DoDot:2
+87 ;
+88 IF $$CHKHASH(.HASH,I,"monographSource")
SET IPMON=IPMON+1
SET @NODE@("PMON",IPMON,0)=$$COPYRITE(HASH(I,"monographSource"))
+89 ;
+90 ; Write consumer monograph
+91 ; consumer monograph NOT currently available TODO add when available
+92 QUIT
End DoDot:1
+93 KILL PSSCLIN,PSSDRGNM,PSSCHK
+94 QUIT
+95 ;;
CHKHASH(HASH,CNT,SUB1,SUB2) ;
+1 ;CHECKS if hash node has data
+2 ;inputs: HASH-ARRAY PASSED IN BY REF
+3 ; CNT-The hash number passed in
+4 ; SUB1--First subscript
+5 ; SUB2 (OPTIONAL)-SECOND SUBSCRIPT
+6 ;RETURNS LENGTH OF DATA IN NODE OR 0 IF DOESN'T EXIST
+7 NEW RESULT
+8 Begin DoDot:1
+9 IF $LENGTH($GET(SUB2))
Begin DoDot:2
+10 SET RESULT=$LENGTH($GET(HASH(CNT,SUB1,SUB2)))
End DoDot:2
QUIT
+11 SET RESULT=$LENGTH($GET(HASH(CNT,SUB1)))
End DoDot:1
+12 QUIT RESULT
+13 ;
TRANSEV(SEV) ;
+1 ; @DESC Translates the severity attribute returned by the XML into
+2 ; a VistA specific severity
+3 ;
+4 ; @SEV Severity returned from the XML
+5 ;
+6 ; @RETURNS VistA specific severity
+7 ;
+8 ; DrugDrugChecks with an FDB severity of "Contraindicated Drug Combination"
+9 ; will be displayed as "Critical".
+10 ; DrugDrugChecks with an FDB severity of "Severe Interaction" will be displayed as "Significant".
+11 ; IMPORTANT:
+12 ; DrugDrugChecks that are not 'critical' or 'significant' are not included in output global.
+13 QUIT $SELECT(SEV="Contraindicated Drug Combination":"Critical",SEV="Severe Interaction":"Significant",1:-1)
+14 ;;
SEVCODE(SEV) ;
+1 ; @DESC Returns the proper severity code depending on the VistA specific severity
+2 ;
+3 ; @SEV VistA specific severity.
+4 ;
+5 ; @RETURNS Returns severity code. 'C' for Critical. 'S' for Significant.
+6 ;
+7 QUIT $SELECT(SEV="Critical":"C",SEV="Significant":"S")
+8 ;;
COPYRITE(SOURCE) ;
+1 ; @DESC Returns correct copyright disclaimer for FDB OR VA PBM in format
+2 ; @Copyright [Current Year] First DataBank, Inc.
+3 ; @Information provided by VA PBM-SHG
+4 ; @INPUT: source FDB OR Custom
+5 ; @RETURNS FDB copyright OR va pbm information
+6 ;
+7 NEW PSS
+8 ;
+9 NEW %I
+10 DO NOW^%DTC
+11 SET PSS("fileManYear")=%I(3)
+12 ; File man years begin at 1700
+13 SET PSS("year")=PSS("fileManYear")+1700
+14 ;
+15 ;Case on Source
Begin DoDot:1
+16 IF SOURCE="Custom"
SET PSS("source")="Information provided by VA PBM-SHG"
QUIT
+17 SET PSS("source")="Copyright "_PSS("year")_" First Databank, Inc."
End DoDot:1
+18 QUIT PSS("source")
+19 ;;
+20 ;;
