PSSHRVAL ;WOIFO/AV,TS,SG - Data Validation routine for drug checks ; Jan 15, 2007@16:00
 ;;1.0;PHARMACY DATA MANAGEMENT;**136,160,178,254**;9/30/97;Build 109
 ;
 ;
 ;@NOTE: The exception node looks like this.
 ;PSSHASH("Exception","PROSPECTIVE","DOSE",PharmacyOrderNum,Counter)=Gcn,Vuid,IEN,DrugName,CprsOrderNum,Package,Reason,ReasonCode,ResonSource,ReasonText
 ;PSSHASH("Exception","PROSPECTIVE",PharmacyOrderNum,Counter)=Gcn,Vuid,IEN,DrugName,CprsOrderNum,Package,Reason,ReasonCode,ResonSource,ReasonText
 ;PSSHASH("Exception","PROFILE",PharmacyOrderNum,Counter)=Gcn,Vuid,IEN,DrugName,CprsOrderNum,Package,Reason,ReasonCode,ResonSource,ReasonText
 ;PSSHASH("Exception","PatientIenMissing")=""
 ;PSSHASH("Message")="Failed Validation"
 ;PSSHASH("ReasonCode")="Reason Code Not Determined Yet"
 ;
 ;
 ;^TMP GLOBAL DATA=GCNSEQNO^VUID^IEN^NAME^DOSE AMOUNT^DOSE UNIT^DOSE RATE^FREQ^DURATION^DURATION RATE^ROUTE^DOSE TYPE^not used^DOSE FORM FLAG
 ;
 ;Business rules:
 ;1. If a prospective" node does not have a GCNSEQNO, it will be KILLED
 ;2.If a "profile" node does not have a GCNSEQNO, it will be KILLED
 ;3.If no prospective nodes exist, DRUGDRUG,THERAPY and DOSE will be killed off
 ;4.Only checks will be performed for those check nodes that still exist (e.g. DRUGDRUG,
 ;THERAPY and DOSE)
 ;If any of the demographics are out of range (age<=0,BSA<0 (or null) or Weight<0 or null) dose node will be killed.
 ;
 QUIT
 ;;
DRIVER(PSSBASE) ;
 ;@DRIVER
 ;@DESC The driver for the validation of drug checks.
 ;@PSSBASE The base
 ;
 NEW PSSHASH
 ;
 SET PSSHASH("Base")=PSSBASE
 SET PSSHASH("ReasonCode")="" ;for version 0.5 version not yet defined.
 ;
 DO BUILD(.PSSHASH)
 ;
 DO WRITE^PSSHRVL1(.PSSHASH)
 DO CHKNODES(.PSSHASH)
 QUIT $$CONTINUE(.PSSHASH)
 ;
CHKNODES(PSSHASH) ;
 ;@DESC Determines which nodes should be killed off or kept
 ;
 ;SET DoseValue,"Demo" PSSHASH array to kill off dose node
 NEW ORDER
 ;
 SET ORDER=""
 IF '$L($O(^TMP($JOB,PSSHASH("Base"),"IN","PROSPECTIVE",ORDER))) DO
 .;If only send in profile with profile flag OK
 .I $D(^TMP($JOB,PSSHASH("Base"),"IN","PROFILEVPROFILE"))&($L($O(^TMP($JOB,PSSHASH("Base"),"IN","PROFILE",ORDER)))) Q
 .DO KILLALL^PSSHRVL1(PSSHASH("Base"))
 IF $D(PSSHASH("DoseValue","DEMOAGE")) DO
 .DO KILLCHEK^PSSHRVL1("DOSE",PSSHASH("Base"))
 QUIT
 ;
CONTINUE(PSSHASH) ;
 ;@DESC Determines whether or not to proceed with checks.
 ;@RETURNS 1 if you may continue, 0 if not.
 ;
 NEW PSS
 SET PSS("AnyChecksLeft")=0
 DO:$DATA(^TMP($JOB,PSSHASH("Base"),"IN","DRUGDRUG"))
  . SET PSS("AnyChecksLeft")=1
  . QUIT 
 DO:$DATA(^TMP($JOB,PSSHASH("Base"),"IN","THERAPY"))
 . SET PSS("AnyChecksLeft")=1
 . QUIT
 DO:$DATA(^TMP($JOB,PSSHASH("Base"),"IN","DOSE"))
 . SET PSS("AnyChecksLeft")=1
 . QUIT
 DO:$DATA(^TMP($JOB,PSSHASH("Base"),"IN","PING"))
  . SET PSS("AnyChecksLeft")=1
  . QUIT
 QUIT PSS("AnyChecksLeft")
 ;
BUILD(PSSHASH) ;
 ;@DESC Builds the internal hash used to parse for errors.
 ;@PSSHASH The internal variables.
 ;DO CHKINEXP(.PSSHASH)
 DO CHKINEXP(.PSSHASH) ;CHK FOR "IN" EXCEPTIONS
 DO DRUGPROS(.PSSHASH)
 DO DRUGPROF(.PSSHASH)
 QUIT
 ;
CHKINEXP(PSSHASH) ;
 ;INPUT PSSHASH array
 ;PSSHASH("Exception",TYPE,"DOSE",PSS("PharmOrderNum"),COUNTER)
 ;PSSHASH("Exception",TYPE,PSS("PharmOrderNum"),COUNTER)
 I $D(^TMP($JOB,PSSHASH("Base"),"IN","EXCEPTIONS","OI")) D OIEXP(.PSSHASH)
 I $D(^TMP($JOB,PSSHASH("Base"),"IN","EXCEPTIONS","DOSE")) D DOSINEXP(.PSSHASH)
 Q
 ;
DRUGPROS(PSSHASH) ;
 ;@DESC Loops on the prospective drugs
 ;@PSSHASH The internal variables.
 ;
 NEW PSS
 SET PSS("ProspectiveOrProfile")="PROSPECTIVE"
 SET PSS("PharmOrderNum")=""
 ;
 FOR  SET PSS("PharmOrderNum")=$ORDER(^TMP($JOB,PSSHASH("Base"),"IN","PROSPECTIVE",PSS("PharmOrderNum"))) QUIT:PSS("PharmOrderNum")=""  DO
  . SET PSS("DrugValue")=^TMP($JOB,PSSHASH("Base"),"IN","PROSPECTIVE",PSS("PharmOrderNum"))
  . DO CHECKGCN(.PSS,.PSSHASH)
  . DO CHECKDOS(.PSS,.PSSHASH)
  . QUIT
 QUIT
 ;
DEMOGRAF(PSS,PSSHASH,PSDRUG) ;
 ;@DESC Validates the demographic info
 ;@PSSHASH The hash the demographic info is stored in
 ;
 ;Gcn
 N AGE,WEIGHT,BSA,MESSAGE,ORDER
 ;
 SET PSS("T")=$PIECE(PSS("DoseValue"),"^",1)_"^"
 ;Vuid
 SET PSS("T")=PSS("T")_$PIECE(PSS("DoseValue"),"^",2)_"^"
 ;Ien
 SET PSS("T")=PSS("T")_$PIECE(PSS("DoseValue"),"^",3)_"^"
 ;DrugName
 SET PSS("T")=PSS("T")_$PIECE(PSS("DoseValue"),"^",4)_"^"
 ;CprsOrderNumber
 SET PSS("T")=PSS("T")_$PIECE(PSS("DoseValue"),"^",5)_"^"
 ;Package
 SET PSS("T")=PSS("T")_$PIECE(PSS("DoseValue"),"^",6)_"^"
 ;Reason
 ;SET PSS("T")=PSS("T")_PSSHASH("Message")_"^"
 I $D(^TMP($JOB,PSSHASH("Base"),"IN","DOSE")) D
 .S AGE=+$G(^TMP($J,PSSHASH("Base"),"IN","DOSE","AGE"))
 .S WEIGHT=+$G(^TMP($J,PSSHASH("Base"),"IN","DOSE","WT"))
 .S BSA=+$G(^TMP($J,PSSHASH("Base"),"IN","DOSE","BSA"))
 .;Validate age in days exists or BSA or Weight are not less than zero.
 .S MESSAGE=$$DEMOCHK^PSSHRVL1(AGE,BSA,WEIGHT,PSDRUG,$G(PSSDSWHE)) Q:'$L(MESSAGE)  ;IF NO ISSUE DON'T GO ANY FURTHER
 .S PSSNOAGE=1
 .I AGE'>0 D SETDSEXP(.PSS,.PSSHASH,MESSAGE,0,1),PSSDBCAR
 .;cmf rtc#509375;I WEIGHT'>0 D SETDSEXP(.PSS,.PSSHASH,MESSAGE,0,3)
 .;cmf rtc#509375;I BSA'>0 D SETDSEXP(.PSS,.PSSHASH,MESSAGE,0,4)
 .;This is already looping through all dose nodes from DRUGPROS
 .;IF BAD DEMOGRAPHIC Set array node below and have CHKNODES tag kill Dose node
 .S PSSHASH("DoseValue","DEMOAGE")=""
 KILL PSS("T")
 QUIT 
 ;
PSSDBCAR ; set global array for setting dose output globals ; cmf RTC #159140, #163341
 Q:'$D(PSSDBCAR)
 Q:'$D(PSS("PharmOrderNum"))
 S $P(PSSDBCAR(PSS("PharmOrderNum")),U,27)=1
 Q
 ;;
CHECKDOS(PSS,PSSHASH) ; 
 ;@DESC Check if the dose exists.
 ;@PSS The temp hash
 ;@PSSHASH The internal hash
 N DOSEVALUE,DOSE,DOSEUNIT,DOSERATE,FREQ,DURATION,DURRATE,ROUTE,DOSETYPE,DRUGNM,MESSAGE,PSSNOAGE
 DO:$DATA(^TMP($JOB,PSSHASH("Base"),"IN","DOSE",PSS("PharmOrderNum")))
  .;if prospective killed off then GCN bad-no need to go any further
  . I '$DATA(^TMP($JOB,PSSHASH("Base"),"IN","PROSPECTIVE",PSS("PharmOrderNum"))) Q
  . SET PSS("DoseValue")=^TMP($JOB,PSSHASH("Base"),"IN","DOSE",PSS("PharmOrderNum"))
  . SET PSS("Package")=""
  . SET PSS("ReasonSource")=$$GETUCI^PSSHRVL1()
  . ;
  . ;I '$$DEMOGRAF(.PSS,.PSSHASH) Q  ;Check age and other parameters
  . ;If this is a "specific" call
  . ;SET PSS("Package")="N/A"
  . ;SET PSS("ReasonSource")=$$GETUCI^PSSHRVL1()
  . ;SET PSS("Message")=PSSHASH("Message")
  . S DOSEVALUE=PSS("DoseValue")
  . S DRUGNM=$P(DOSEVALUE,U,4)
  . S DOSE=$P(DOSEVALUE,U,5),DOSEUNIT=$P(DOSEVALUE,U,6),DOSERATE=$P(DOSEVALUE,U,7)
  . S FREQ=$P(DOSEVALUE,U,8),DURATION=$P(DOSEVALUE,U,9)
  . S DURRATE=$P(DOSEVALUE,U,10),ROUTE=$P(DOSEVALUE,U,11),DOSETYPE=$P(DOSEVALUE,U,12)
  . ;Check piece 12--if not set correctly go no further
  . S PSSNOAGE=0 D DEMOGRAF(.PSS,.PSSHASH,DRUGNM)  Q:PSSNOAGE  ;Check age and other parameters
  . S MESSAGE=$$CHKDSTYP^PSSHRVL1(DOSETYPE,DRUGNM) I $L(MESSAGE) D
  . . D SETDSEXP(.PSS,.PSSHASH,MESSAGE,12,2)
  . ;set defaults for all possible errors
  . ;check piece 5 dose
  . S MESSAGE=$$CHKDOSE^PSSHRVL1(DOSE,DRUGNM) I $L(MESSAGE) D
  . .D SETDSEXP(.PSS,.PSSHASH,MESSAGE,5)
  . ;check piece 6-dose units
  . S MESSAGE=$$CHKUNIT^PSSHRVL1(DOSEUNIT,DRUGNM) I $L(MESSAGE) D
  . .D SETDSEXP(.PSS,.PSSHASH,MESSAGE,6)
  . ;Check piece 7--dose rate
  . S MESSAGE=$$CHKRATE^PSSHRVL1(DOSERATE,"DOSE",DRUGNM) I $L(MESSAGE) D
  . . D SETDSEXP(.PSS,.PSSHASH,MESSAGE,7)
  . ;Check Piece 8--frequency
  . ;S MESSAGE=$$CHKFREQ^PSSHRVL1(FREQ) I $L(MESSAGE) D
  . ;.D SETDSEXP(.PSS,.PSSHASH,MESSAGE,8)
  . ;Check piece 9-duration
  . S MESSAGE=$$CHKDRATN^PSSHRVL1(DURATION,DRUGNM) I $L(MESSAGE) D
  . .D SETDSEXP(.PSS,.PSSHASH,MESSAGE,9)
  . ;Check piece 10-DURATION RATE
  . S MESSAGE=$$CHKRATE^PSSHRVL1(DURRATE,"DURATION",DRUGNM,DURATION) I $L(MESSAGE) D
  . .D SETDSEXP(.PSS,.PSSHASH,MESSAGE,10)
  . ;PIECE 11-ROUTE
  . S MESSAGE=$$MEDRTE^PSSHRVL1(ROUTE,DRUGNM) I $L(MESSAGE) D
  . .D SETDSEXP(.PSS,.PSSHASH,MESSAGE,11,2)
  . QUIT   ;Checking if dose exists.
 QUIT
 ;
SETDSEXP(PSS,PSSHASH,MESSAGE,DOSPIECE,PSSDBIN) ;
 ;SET DOSE EXCEPTION
 ;PSS-ARRAY OF MED PROFILE INFORMATION(BY REF)
 ;PSSHASH-HOLDS DATA EXCEPTION (BY REF)
 ;MESSAGE-REASON AND ERROR REASON
 ;DOSEPIECE-THE OFFENDING PIECE OF DATA FROM DOSING INFORMATON-NOT SENT IF FROM
 ;DEMOGRAF CALL.
 ;
 SET PSS("Counter")=$$NEXTDOS(.PSS,.PSSHASH)
 SET PSS("ReasonCode")=PSSHASH("ReasonCode")
 SET PSS("Message")=$P(MESSAGE,U)
 SET PSS("ReasonText")=$P(MESSAGE,U,2)
 SET PSS("CprsOrderNumber")=""
 SET PSSHASH("Exception",PSS("ProspectiveOrProfile"),"DOSE",PSS("PharmOrderNum"),PSS("Counter"))=$$DOSPIECE(.PSS)
 I $G(DOSPIECE) SET PSSHASH("DoseValue",DOSPIECE)=""
 D KILLNODE^PSSHRVL1(PSSHASH("Base"),"DOSE",PSS("PharmOrderNum"))
 D KILLNODE^PSSHRVL1(PSSHASH("Base"),"PROSPECTIVE",PSS("PharmOrderNum"))
 S $P(PSSDBCAR(PSS("PharmOrderNum")),"^",13)=1
 S:$G(PSSDBIN)=1 $P(PSSDBCAR(PSS("PharmOrderNum")),"^",19)=1
 S:$G(PSSDBIN)=2 $P(PSSDBCAR(PSS("PharmOrderNum")),"^",23)=1
 S:$G(PSSDBIN)=3 $P(PSSDBCAR(PSS("PharmOrderNum")),"^",25)=1
 S:$G(PSSDBIN)=4 $P(PSSDBCAR(PSS("PharmOrderNum")),"^",26)=1
 QUIT
 ;
DOSINEXP(PSSHASH) ;
 N ORDERNUM,MESSAGE,REASON,DRUGNM,ERRNUM,TMPNODE,PSS
 S ORDERNUM=""
 F  S ORDERNUM=$O(^TMP($JOB,PSSHASH("Base"),"IN","EXCEPTIONS","DOSE",ORDERNUM)) Q:'$L(ORDERNUM)  D
 .S TMPNODE=$G(^TMP($JOB,PSSHASH("Base"),"IN","EXCEPTIONS","DOSE",ORDERNUM)) Q:'$L(TMPNODE)
 .S ERRNUM=+TMPNODE  ;ERROR NUMBER
 .S DRUGNM=$P(TMPNODE,U,2)
 .S MESSAGE=$$DOSEMSG^PSSHRVL1(DRUGNM)
 .S REASON=$$INRSON^PSSHRVL1(ERRNUM)
 .S MESSAGE=MESSAGE_U_REASON
 .S PSS("PharmOrderNum")=ORDERNUM
 .S PSS("ProspectiveOrProfile")="PROSPECTIVE"
 .S PSS("Package")=""
 .S PSS("DoseValue")=""
 .S PSS("ReasonSource")=$$GETUCI^PSSHRVL1()
 .D SETDSEXP(.PSS,.PSSHASH,MESSAGE)
 Q
 ;
OIEXP(PSSHASH) ;
 N ORDITEM,ERRNUM,MESSAGE,REASON,PSS,ORDERNUM,TMPNODE
 S ORDITEM=""
 F  S ORDITEM=$O(^TMP($JOB,PSSHASH("Base"),"IN","EXCEPTIONS","OI",ORDITEM)) Q:'$L(ORDITEM)  D
 .S TMPNODE=$G(^TMP($JOB,PSSHASH("Base"),"IN","EXCEPTIONS","OI",ORDITEM)) Q:'$L(TMPNODE)
 .S ERRNUM=+TMPNODE  ;ERROR NUMBER
 .S ORDERNUM=$P(TMPNODE,U,2)
 .S MESSAGE=$$OIMSG^PSSHRVL1(ORDITEM,ORDERNUM)
 .S REASON="" I $E(PSSHASH("Base"),1,2)="PS" S REASON=$$INRSON^PSSHRVL1(ERRNUM,ORDERNUM)
 .S $P(PSS("I"),U,7)=MESSAGE
 .S $P(PSS("I"),U,10)=REASON
 .S PSS("PharmOrderNum")=ORDERNUM
 .S PSS("ProspectiveOrProfile")=$S($$ISPROF^PSSHRCOM(ORDERNUM):"PROFILE",1:"PROSPECTIVE")
 .S PSS("Package")=""
 .S PSS("DoseValue")=""
 .S PSS("ReasonSource")=$$GETUCI^PSSHRVL1()
 .S PSS("Counter")=$$NEXTGCN(.PSS,.PSSHASH)
 .D SETEXCP(.PSS,.PSSHASH)
 .D HDOSE(ORDERNUM) D KILLNODE^PSSHRVL1(PSSHASH("Base"),PSS("ProspectiveOrProfile"),ORDERNUM)
 Q
 ;
NEXTDOS(PSS,PSSHASH) ;
 ;@DESC Gets the next dose
 ;@PSS The temp hash
 ;@PSSHASH The internal hash ;
 ;@NOTE PSSHASH looks like this: 
 ; PSSHASH("Exception","PROSPECTIVE","DOSE",PharmacyOrderNum,Counter
 ; 
 N PSNEXT
 S PSNEXT=":"
 S PSNEXT=$ORDER(PSSHASH("Exception","PROSPECTIVE","DOSE",PSS("PharmOrderNum"),PSNEXT),-1)
 Q PSNEXT+1
 ;
NEXTGCN(PSS,PSSHASH) ;
 ;@DESC Gets the next Gcn
 ;@PSS The temp hash
 ;@PSSHASH The internal hash
 ;
 N PSNEXT
 S PSNEXT=":"
 S PSNEXT=$ORDER(PSSHASH("Exception",PSS("ProspectiveOrProfile"),PSS("PharmOrderNum"),PSNEXT),-1)
 Q PSNEXT+1
 ;
DOSPIECE(PSS) ;
 ;@DESC Appends all pre-defined pieces to a temp var
 ;@PSS The temp hash
 ;@RETURNS The appended temp var.
 ;
 SET PSS("I")=$PIECE(PSS("DoseValue"),"^",1)_"^" ;GCN
 SET PSS("I")=PSS("I")_$PIECE(PSS("DoseValue"),"^",2)_"^" ;Vuid
 SET PSS("I")=PSS("I")_$PIECE(PSS("DoseValue"),"^",3)_"^" ;Ien
 SET PSS("I")=PSS("I")_$PIECE(PSS("DoseValue"),"^",4)_"^" ;DrugName
 SET PSS("I")=PSS("I")_PSS("CprsOrderNumber")_"^" ;CprsOrderNumber
 SET PSS("I")=PSS("I")_PSS("Package")_"^" ;Package
 SET PSS("I")=PSS("I")_PSS("Message")_"^"
 SET PSS("I")=PSS("I")_PSS("ReasonCode")_"^"
 SET PSS("I")=PSS("I")_PSS("ReasonSource")_"^"
 SET PSS("I")=PSS("I")_PSS("ReasonText")
 QUIT PSS("I")
 ;
CHECKGCN(PSS,PSSHASH) ;
 ;@DESC Checks the GCN for a Drug
 ;@PSS A temp array
 ;@PSSHASH The input array
 ;@ASSERT PSS("DrugValue") exists.
 ;
 N DRUGNM,DRUGIEN,MESSAGE,REASON,BADGCN
 SET PSS("Counter")="0"
 DO:'$PIECE(PSS("DrugValue"),"^",1)
  . SET DRUGIEN=$P(PSS("DrugValue"),"^",3)
  . SET DRUGNM=$P(PSS("DrugValue"),"^",4)
  . S BADGCN=0
  . S:$PIECE(PSS("DrugValue"),"^",1)'?1.N BADGCN=-1
  . SET MESSAGE=$S('$D(^TMP($J,"SAVE","IN","GCNMSG")):$$GCNREASN^PSSHRVL1(DRUGIEN,DRUGNM,PSS("PharmOrderNum"),BADGCN),1:"")
  . I $L(MESSAGE) SET REASON=$P(MESSAGE,U,2,3),MESSAGE=$P(MESSAGE,U)
  . SET PSS("Counter")=$$NEXTGCN(.PSS,.PSSHASH)
  . SET PSS("I")="^" ;Gcn
  . SET PSS("I")=PSS("I")_$PIECE(PSS("DrugValue"),"^",2)_"^" ;Vuid
  . SET PSS("I")=PSS("I")_$PIECE(PSS("DrugValue"),"^",3)_"^" ;Ien
  . SET PSS("I")=PSS("I")_$PIECE(PSS("DrugValue"),"^",4)_"^" ;DrugName
  . SET PSS("I")=PSS("I")_$PIECE(PSS("DrugValue"),"^",5)_"^" ;CprsOrderNumber
  . SET PSS("I")=PSS("I")_$PIECE(PSS("DrugValue"),"^",6)_"^" ;Package
  . SET PSS("I")=PSS("I")_MESSAGE_"^"
  . ;Reason code is null for 0.5
  . SET PSS("I")=PSS("I")_PSSHASH("ReasonCode")_U
  . ;Set reason text
  . SET PSS("I")=PSS("I")_$$GETUCI^PSSHRVL1()_U
  . SET PSS("I")=PSS("I")_REASON
  . ;
  . D SETEXCP(.PSS,.PSSHASH)
  . D HDOSE(PSS("PharmOrderNum")) D KILLNODE^PSSHRVL1(PSSHASH("Base"),PSS("ProspectiveOrProfile"),PSS("PharmOrderNum"))
 QUIT
 ;
SETEXCP(PSS,PSSHASH) ;
 SET PSSHASH("Exception",PSS("ProspectiveOrProfile"),PSS("PharmOrderNum"),PSS("Counter"))=PSS("I")
 Q
 ;
DRUGPROF(PSSHASH) ;
 ;@DESC Checks the profile drugs.
 ;@PSSHASH The internal hash
 ;
 NEW PSS
 SET PSS("ProspectiveOrProfile")="PROFILE"
 SET PSS("PharmOrderNum")=""
 FOR  SET PSS("PharmOrderNum")=$ORDER(^TMP($JOB,PSSHASH("Base"),"IN",PSS("ProspectiveOrProfile"),PSS("PharmOrderNum"))) QUIT:PSS("PharmOrderNum")=""  DO
  . SET PSS("DrugValue")=^TMP($JOB,PSSHASH("Base"),"IN",PSS("ProspectiveOrProfile"),PSS("PharmOrderNum"))
  . DO CHECKGCN(.PSS,.PSSHASH)
  . QUIT
 QUIT
 ;
 ;
HDOSE(PSSDLDOS) ; If it's a Dose Call
 I '$D(^TMP($J,PSSHASH("Base"),"IN","DOSE",PSSDLDOS)) Q
 D KILLNODE^PSSHRVL1(PSSHASH("Base"),"DOSE",PSSDLDOS)
 S $P(PSSDBCAR(PSSDLDOS),"^",13)=1
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSHRVAL   14423     printed  Sep 23, 2025@20:07:42                                                                                                                                                                                                   Page 2
PSSHRVAL  ;WOIFO/AV,TS,SG - Data Validation routine for drug checks ; Jan 15, 2007@16:00
 +1       ;;1.0;PHARMACY DATA MANAGEMENT;**136,160,178,254**;9/30/97;Build 109
 +2       ;
 +3       ;
 +4       ;@NOTE: The exception node looks like this.
 +5       ;PSSHASH("Exception","PROSPECTIVE","DOSE",PharmacyOrderNum,Counter)=Gcn,Vuid,IEN,DrugName,CprsOrderNum,Package,Reason,ReasonCode,ResonSource,ReasonText
 +6       ;PSSHASH("Exception","PROSPECTIVE",PharmacyOrderNum,Counter)=Gcn,Vuid,IEN,DrugName,CprsOrderNum,Package,Reason,ReasonCode,ResonSource,ReasonText
 +7       ;PSSHASH("Exception","PROFILE",PharmacyOrderNum,Counter)=Gcn,Vuid,IEN,DrugName,CprsOrderNum,Package,Reason,ReasonCode,ResonSource,ReasonText
 +8       ;PSSHASH("Exception","PatientIenMissing")=""
 +9       ;PSSHASH("Message")="Failed Validation"
 +10      ;PSSHASH("ReasonCode")="Reason Code Not Determined Yet"
 +11      ;
 +12      ;
 +13      ;^TMP GLOBAL DATA=GCNSEQNO^VUID^IEN^NAME^DOSE AMOUNT^DOSE UNIT^DOSE RATE^FREQ^DURATION^DURATION RATE^ROUTE^DOSE TYPE^not used^DOSE FORM FLAG
 +14      ;
 +15      ;Business rules:
 +16      ;1. If a prospective" node does not have a GCNSEQNO, it will be KILLED
 +17      ;2.If a "profile" node does not have a GCNSEQNO, it will be KILLED
 +18      ;3.If no prospective nodes exist, DRUGDRUG,THERAPY and DOSE will be killed off
 +19      ;4.Only checks will be performed for those check nodes that still exist (e.g. DRUGDRUG,
 +20      ;THERAPY and DOSE)
 +21      ;If any of the demographics are out of range (age<=0,BSA<0 (or null) or Weight<0 or null) dose node will be killed.
 +22      ;
 +23       QUIT 
 +24      ;;
DRIVER(PSSBASE) ;
 +1       ;@DRIVER
 +2       ;@DESC The driver for the validation of drug checks.
 +3       ;@PSSBASE The base
 +4       ;
 +5        NEW PSSHASH
 +6       ;
 +7        SET PSSHASH("Base")=PSSBASE
 +8       ;for version 0.5 version not yet defined.
           SET PSSHASH("ReasonCode")=""
 +9       ;
 +10       DO BUILD(.PSSHASH)
 +11      ;
 +12       DO WRITE^PSSHRVL1(.PSSHASH)
 +13       DO CHKNODES(.PSSHASH)
 +14       QUIT $$CONTINUE(.PSSHASH)
 +15      ;
CHKNODES(PSSHASH) ;
 +1       ;@DESC Determines which nodes should be killed off or kept
 +2       ;
 +3       ;SET DoseValue,"Demo" PSSHASH array to kill off dose node
 +4        NEW ORDER
 +5       ;
 +6        SET ORDER=""
 +7        IF '$LENGTH($ORDER(^TMP($JOB,PSSHASH("Base"),"IN","PROSPECTIVE",ORDER)))
               Begin DoDot:1
 +8       ;If only send in profile with profile flag OK
 +9                IF $DATA(^TMP($JOB,PSSHASH("Base"),"IN","PROFILEVPROFILE"))&($LENGTH($ORDER(^TMP($JOB,PSSHASH("Base"),"IN","PROFILE",ORDER))))
                       QUIT 
 +10               DO KILLALL^PSSHRVL1(PSSHASH("Base"))
               End DoDot:1
 +11       IF $DATA(PSSHASH("DoseValue","DEMOAGE"))
               Begin DoDot:1
 +12               DO KILLCHEK^PSSHRVL1("DOSE",PSSHASH("Base"))
               End DoDot:1
 +13       QUIT 
 +14      ;
CONTINUE(PSSHASH) ;
 +1       ;@DESC Determines whether or not to proceed with checks.
 +2       ;@RETURNS 1 if you may continue, 0 if not.
 +3       ;
 +4        NEW PSS
 +5        SET PSS("AnyChecksLeft")=0
 +6        if $DATA(^TMP($JOB,PSSHASH("Base"),"IN","DRUGDRUG"))
               Begin DoDot:1
 +7                SET PSS("AnyChecksLeft")=1
 +8                QUIT 
               End DoDot:1
 +9        if $DATA(^TMP($JOB,PSSHASH("Base"),"IN","THERAPY"))
               Begin DoDot:1
 +10               SET PSS("AnyChecksLeft")=1
 +11               QUIT 
               End DoDot:1
 +12       if $DATA(^TMP($JOB,PSSHASH("Base"),"IN","DOSE"))
               Begin DoDot:1
 +13               SET PSS("AnyChecksLeft")=1
 +14               QUIT 
               End DoDot:1
 +15       if $DATA(^TMP($JOB,PSSHASH("Base"),"IN","PING"))
               Begin DoDot:1
 +16               SET PSS("AnyChecksLeft")=1
 +17               QUIT 
               End DoDot:1
 +18       QUIT PSS("AnyChecksLeft")
 +19      ;
BUILD(PSSHASH) ;
 +1       ;@DESC Builds the internal hash used to parse for errors.
 +2       ;@PSSHASH The internal variables.
 +3       ;DO CHKINEXP(.PSSHASH)
 +4       ;CHK FOR "IN" EXCEPTIONS
           DO CHKINEXP(.PSSHASH)
 +5        DO DRUGPROS(.PSSHASH)
 +6        DO DRUGPROF(.PSSHASH)
 +7        QUIT 
 +8       ;
CHKINEXP(PSSHASH) ;
 +1       ;INPUT PSSHASH array
 +2       ;PSSHASH("Exception",TYPE,"DOSE",PSS("PharmOrderNum"),COUNTER)
 +3       ;PSSHASH("Exception",TYPE,PSS("PharmOrderNum"),COUNTER)
 +4        IF $DATA(^TMP($JOB,PSSHASH("Base"),"IN","EXCEPTIONS","OI"))
               DO OIEXP(.PSSHASH)
 +5        IF $DATA(^TMP($JOB,PSSHASH("Base"),"IN","EXCEPTIONS","DOSE"))
               DO DOSINEXP(.PSSHASH)
 +6        QUIT 
 +7       ;
DRUGPROS(PSSHASH) ;
 +1       ;@DESC Loops on the prospective drugs
 +2       ;@PSSHASH The internal variables.
 +3       ;
 +4        NEW PSS
 +5        SET PSS("ProspectiveOrProfile")="PROSPECTIVE"
 +6        SET PSS("PharmOrderNum")=""
 +7       ;
 +8        FOR 
               SET PSS("PharmOrderNum")=$ORDER(^TMP($JOB,PSSHASH("Base"),"IN","PROSPECTIVE",PSS("PharmOrderNum")))
               if PSS("PharmOrderNum")=""
                   QUIT 
               Begin DoDot:1
 +9                SET PSS("DrugValue")=^TMP($JOB,PSSHASH("Base"),"IN","PROSPECTIVE",PSS("PharmOrderNum"))
 +10               DO CHECKGCN(.PSS,.PSSHASH)
 +11               DO CHECKDOS(.PSS,.PSSHASH)
 +12               QUIT 
               End DoDot:1
 +13       QUIT 
 +14      ;
DEMOGRAF(PSS,PSSHASH,PSDRUG) ;
 +1       ;@DESC Validates the demographic info
 +2       ;@PSSHASH The hash the demographic info is stored in
 +3       ;
 +4       ;Gcn
 +5        NEW AGE,WEIGHT,BSA,MESSAGE,ORDER
 +6       ;
 +7        SET PSS("T")=$PIECE(PSS("DoseValue"),"^",1)_"^"
 +8       ;Vuid
 +9        SET PSS("T")=PSS("T")_$PIECE(PSS("DoseValue"),"^",2)_"^"
 +10      ;Ien
 +11       SET PSS("T")=PSS("T")_$PIECE(PSS("DoseValue"),"^",3)_"^"
 +12      ;DrugName
 +13       SET PSS("T")=PSS("T")_$PIECE(PSS("DoseValue"),"^",4)_"^"
 +14      ;CprsOrderNumber
 +15       SET PSS("T")=PSS("T")_$PIECE(PSS("DoseValue"),"^",5)_"^"
 +16      ;Package
 +17       SET PSS("T")=PSS("T")_$PIECE(PSS("DoseValue"),"^",6)_"^"
 +18      ;Reason
 +19      ;SET PSS("T")=PSS("T")_PSSHASH("Message")_"^"
 +20       IF $DATA(^TMP($JOB,PSSHASH("Base"),"IN","DOSE"))
               Begin DoDot:1
 +21               SET AGE=+$GET(^TMP($JOB,PSSHASH("Base"),"IN","DOSE","AGE"))
 +22               SET WEIGHT=+$GET(^TMP($JOB,PSSHASH("Base"),"IN","DOSE","WT"))
 +23               SET BSA=+$GET(^TMP($JOB,PSSHASH("Base"),"IN","DOSE","BSA"))
 +24      ;Validate age in days exists or BSA or Weight are not less than zero.
 +25      ;IF NO ISSUE DON'T GO ANY FURTHER
                   SET MESSAGE=$$DEMOCHK^PSSHRVL1(AGE,BSA,WEIGHT,PSDRUG,$GET(PSSDSWHE))
                   if '$LENGTH(MESSAGE)
                       QUIT 
 +26               SET PSSNOAGE=1
 +27               IF AGE'>0
                       DO SETDSEXP(.PSS,.PSSHASH,MESSAGE,0,1)
                       DO PSSDBCAR
 +28      ;cmf rtc#509375;I WEIGHT'>0 D SETDSEXP(.PSS,.PSSHASH,MESSAGE,0,3)
 +29      ;cmf rtc#509375;I BSA'>0 D SETDSEXP(.PSS,.PSSHASH,MESSAGE,0,4)
 +30      ;This is already looping through all dose nodes from DRUGPROS
 +31      ;IF BAD DEMOGRAPHIC Set array node below and have CHKNODES tag kill Dose node
 +32               SET PSSHASH("DoseValue","DEMOAGE")=""
               End DoDot:1
 +33       KILL PSS("T")
 +34       QUIT 
 +35      ;
PSSDBCAR  ; set global array for setting dose output globals ; cmf RTC #159140, #163341
 +1        if '$DATA(PSSDBCAR)
               QUIT 
 +2        if '$DATA(PSS("PharmOrderNum"))
               QUIT 
 +3        SET $PIECE(PSSDBCAR(PSS("PharmOrderNum")),U,27)=1
 +4        QUIT 
 +5       ;;
CHECKDOS(PSS,PSSHASH) ; 
 +1       ;@DESC Check if the dose exists.
 +2       ;@PSS The temp hash
 +3       ;@PSSHASH The internal hash
 +4        NEW DOSEVALUE,DOSE,DOSEUNIT,DOSERATE,FREQ,DURATION,DURRATE,ROUTE,DOSETYPE,DRUGNM,MESSAGE,PSSNOAGE
 +5        if $DATA(^TMP($JOB,PSSHASH("Base"),"IN","DOSE",PSS("PharmOrderNum")))
               Begin DoDot:1
 +6       ;if prospective killed off then GCN bad-no need to go any further
 +7                IF '$DATA(^TMP($JOB,PSSHASH("Base"),"IN","PROSPECTIVE",PSS("PharmOrderNum")))
                       QUIT 
 +8                SET PSS("DoseValue")=^TMP($JOB,PSSHASH("Base"),"IN","DOSE",PSS("PharmOrderNum"))
 +9                SET PSS("Package")=""
 +10               SET PSS("ReasonSource")=$$GETUCI^PSSHRVL1()
 +11      ;
 +12      ;I '$$DEMOGRAF(.PSS,.PSSHASH) Q  ;Check age and other parameters
 +13      ;If this is a "specific" call
 +14      ;SET PSS("Package")="N/A"
 +15      ;SET PSS("ReasonSource")=$$GETUCI^PSSHRVL1()
 +16      ;SET PSS("Message")=PSSHASH("Message")
 +17               SET DOSEVALUE=PSS("DoseValue")
 +18               SET DRUGNM=$PIECE(DOSEVALUE,U,4)
 +19               SET DOSE=$PIECE(DOSEVALUE,U,5)
                   SET DOSEUNIT=$PIECE(DOSEVALUE,U,6)
                   SET DOSERATE=$PIECE(DOSEVALUE,U,7)
 +20               SET FREQ=$PIECE(DOSEVALUE,U,8)
                   SET DURATION=$PIECE(DOSEVALUE,U,9)
 +21               SET DURRATE=$PIECE(DOSEVALUE,U,10)
                   SET ROUTE=$PIECE(DOSEVALUE,U,11)
                   SET DOSETYPE=$PIECE(DOSEVALUE,U,12)
 +22      ;Check piece 12--if not set correctly go no further
 +23      ;Check age and other parameters
                   SET PSSNOAGE=0
                   DO DEMOGRAF(.PSS,.PSSHASH,DRUGNM)
                   if PSSNOAGE
                       QUIT 
 +24               SET MESSAGE=$$CHKDSTYP^PSSHRVL1(DOSETYPE,DRUGNM)
                   IF $LENGTH(MESSAGE)
                       Begin DoDot:2
 +25                       DO SETDSEXP(.PSS,.PSSHASH,MESSAGE,12,2)
                       End DoDot:2
 +26      ;set defaults for all possible errors
 +27      ;check piece 5 dose
 +28               SET MESSAGE=$$CHKDOSE^PSSHRVL1(DOSE,DRUGNM)
                   IF $LENGTH(MESSAGE)
                       Begin DoDot:2
 +29                       DO SETDSEXP(.PSS,.PSSHASH,MESSAGE,5)
                       End DoDot:2
 +30      ;check piece 6-dose units
 +31               SET MESSAGE=$$CHKUNIT^PSSHRVL1(DOSEUNIT,DRUGNM)
                   IF $LENGTH(MESSAGE)
                       Begin DoDot:2
 +32                       DO SETDSEXP(.PSS,.PSSHASH,MESSAGE,6)
                       End DoDot:2
 +33      ;Check piece 7--dose rate
 +34               SET MESSAGE=$$CHKRATE^PSSHRVL1(DOSERATE,"DOSE",DRUGNM)
                   IF $LENGTH(MESSAGE)
                       Begin DoDot:2
 +35                       DO SETDSEXP(.PSS,.PSSHASH,MESSAGE,7)
                       End DoDot:2
 +36      ;Check Piece 8--frequency
 +37      ;S MESSAGE=$$CHKFREQ^PSSHRVL1(FREQ) I $L(MESSAGE) D
 +38      ;.D SETDSEXP(.PSS,.PSSHASH,MESSAGE,8)
 +39      ;Check piece 9-duration
 +40               SET MESSAGE=$$CHKDRATN^PSSHRVL1(DURATION,DRUGNM)
                   IF $LENGTH(MESSAGE)
                       Begin DoDot:2
 +41                       DO SETDSEXP(.PSS,.PSSHASH,MESSAGE,9)
                       End DoDot:2
 +42      ;Check piece 10-DURATION RATE
 +43               SET MESSAGE=$$CHKRATE^PSSHRVL1(DURRATE,"DURATION",DRUGNM,DURATION)
                   IF $LENGTH(MESSAGE)
                       Begin DoDot:2
 +44                       DO SETDSEXP(.PSS,.PSSHASH,MESSAGE,10)
                       End DoDot:2
 +45      ;PIECE 11-ROUTE
 +46               SET MESSAGE=$$MEDRTE^PSSHRVL1(ROUTE,DRUGNM)
                   IF $LENGTH(MESSAGE)
                       Begin DoDot:2
 +47                       DO SETDSEXP(.PSS,.PSSHASH,MESSAGE,11,2)
                       End DoDot:2
 +48      ;Checking if dose exists.
                   QUIT 
               End DoDot:1
 +49       QUIT 
 +50      ;
SETDSEXP(PSS,PSSHASH,MESSAGE,DOSPIECE,PSSDBIN) ;
 +1       ;SET DOSE EXCEPTION
 +2       ;PSS-ARRAY OF MED PROFILE INFORMATION(BY REF)
 +3       ;PSSHASH-HOLDS DATA EXCEPTION (BY REF)
 +4       ;MESSAGE-REASON AND ERROR REASON
 +5       ;DOSEPIECE-THE OFFENDING PIECE OF DATA FROM DOSING INFORMATON-NOT SENT IF FROM
 +6       ;DEMOGRAF CALL.
 +7       ;
 +8        SET PSS("Counter")=$$NEXTDOS(.PSS,.PSSHASH)
 +9        SET PSS("ReasonCode")=PSSHASH("ReasonCode")
 +10       SET PSS("Message")=$PIECE(MESSAGE,U)
 +11       SET PSS("ReasonText")=$PIECE(MESSAGE,U,2)
 +12       SET PSS("CprsOrderNumber")=""
 +13       SET PSSHASH("Exception",PSS("ProspectiveOrProfile"),"DOSE",PSS("PharmOrderNum"),PSS("Counter"))=$$DOSPIECE(.PSS)
 +14       IF $GET(DOSPIECE)
               SET PSSHASH("DoseValue",DOSPIECE)=""
 +15       DO KILLNODE^PSSHRVL1(PSSHASH("Base"),"DOSE",PSS("PharmOrderNum"))
 +16       DO KILLNODE^PSSHRVL1(PSSHASH("Base"),"PROSPECTIVE",PSS("PharmOrderNum"))
 +17       SET $PIECE(PSSDBCAR(PSS("PharmOrderNum")),"^",13)=1
 +18       if $GET(PSSDBIN)=1
               SET $PIECE(PSSDBCAR(PSS("PharmOrderNum")),"^",19)=1
 +19       if $GET(PSSDBIN)=2
               SET $PIECE(PSSDBCAR(PSS("PharmOrderNum")),"^",23)=1
 +20       if $GET(PSSDBIN)=3
               SET $PIECE(PSSDBCAR(PSS("PharmOrderNum")),"^",25)=1
 +21       if $GET(PSSDBIN)=4
               SET $PIECE(PSSDBCAR(PSS("PharmOrderNum")),"^",26)=1
 +22       QUIT 
 +23      ;
DOSINEXP(PSSHASH) ;
 +1        NEW ORDERNUM,MESSAGE,REASON,DRUGNM,ERRNUM,TMPNODE,PSS
 +2        SET ORDERNUM=""
 +3        FOR 
               SET ORDERNUM=$ORDER(^TMP($JOB,PSSHASH("Base"),"IN","EXCEPTIONS","DOSE",ORDERNUM))
               if '$LENGTH(ORDERNUM)
                   QUIT 
               Begin DoDot:1
 +4                SET TMPNODE=$GET(^TMP($JOB,PSSHASH("Base"),"IN","EXCEPTIONS","DOSE",ORDERNUM))
                   if '$LENGTH(TMPNODE)
                       QUIT 
 +5       ;ERROR NUMBER
                   SET ERRNUM=+TMPNODE
 +6                SET DRUGNM=$PIECE(TMPNODE,U,2)
 +7                SET MESSAGE=$$DOSEMSG^PSSHRVL1(DRUGNM)
 +8                SET REASON=$$INRSON^PSSHRVL1(ERRNUM)
 +9                SET MESSAGE=MESSAGE_U_REASON
 +10               SET PSS("PharmOrderNum")=ORDERNUM
 +11               SET PSS("ProspectiveOrProfile")="PROSPECTIVE"
 +12               SET PSS("Package")=""
 +13               SET PSS("DoseValue")=""
 +14               SET PSS("ReasonSource")=$$GETUCI^PSSHRVL1()
 +15               DO SETDSEXP(.PSS,.PSSHASH,MESSAGE)
               End DoDot:1
 +16       QUIT 
 +17      ;
OIEXP(PSSHASH) ;
 +1        NEW ORDITEM,ERRNUM,MESSAGE,REASON,PSS,ORDERNUM,TMPNODE
 +2        SET ORDITEM=""
 +3        FOR 
               SET ORDITEM=$ORDER(^TMP($JOB,PSSHASH("Base"),"IN","EXCEPTIONS","OI",ORDITEM))
               if '$LENGTH(ORDITEM)
                   QUIT 
               Begin DoDot:1
 +4                SET TMPNODE=$GET(^TMP($JOB,PSSHASH("Base"),"IN","EXCEPTIONS","OI",ORDITEM))
                   if '$LENGTH(TMPNODE)
                       QUIT 
 +5       ;ERROR NUMBER
                   SET ERRNUM=+TMPNODE
 +6                SET ORDERNUM=$PIECE(TMPNODE,U,2)
 +7                SET MESSAGE=$$OIMSG^PSSHRVL1(ORDITEM,ORDERNUM)
 +8                SET REASON=""
                   IF $EXTRACT(PSSHASH("Base"),1,2)="PS"
                       SET REASON=$$INRSON^PSSHRVL1(ERRNUM,ORDERNUM)
 +9                SET $PIECE(PSS("I"),U,7)=MESSAGE
 +10               SET $PIECE(PSS("I"),U,10)=REASON
 +11               SET PSS("PharmOrderNum")=ORDERNUM
 +12               SET PSS("ProspectiveOrProfile")=$SELECT($$ISPROF^PSSHRCOM(ORDERNUM):"PROFILE",1:"PROSPECTIVE")
 +13               SET PSS("Package")=""
 +14               SET PSS("DoseValue")=""
 +15               SET PSS("ReasonSource")=$$GETUCI^PSSHRVL1()
 +16               SET PSS("Counter")=$$NEXTGCN(.PSS,.PSSHASH)
 +17               DO SETEXCP(.PSS,.PSSHASH)
 +18               DO HDOSE(ORDERNUM)
                   DO KILLNODE^PSSHRVL1(PSSHASH("Base"),PSS("ProspectiveOrProfile"),ORDERNUM)
               End DoDot:1
 +19       QUIT 
 +20      ;
NEXTDOS(PSS,PSSHASH) ;
 +1       ;@DESC Gets the next dose
 +2       ;@PSS The temp hash
 +3       ;@PSSHASH The internal hash ;
 +4       ;@NOTE PSSHASH looks like this: 
 +5       ; PSSHASH("Exception","PROSPECTIVE","DOSE",PharmacyOrderNum,Counter
 +6       ; 
 +7        NEW PSNEXT
 +8        SET PSNEXT=":"
 +9        SET PSNEXT=$ORDER(PSSHASH("Exception","PROSPECTIVE","DOSE",PSS("PharmOrderNum"),PSNEXT),-1)
 +10       QUIT PSNEXT+1
 +11      ;
NEXTGCN(PSS,PSSHASH) ;
 +1       ;@DESC Gets the next Gcn
 +2       ;@PSS The temp hash
 +3       ;@PSSHASH The internal hash
 +4       ;
 +5        NEW PSNEXT
 +6        SET PSNEXT=":"
 +7        SET PSNEXT=$ORDER(PSSHASH("Exception",PSS("ProspectiveOrProfile"),PSS("PharmOrderNum"),PSNEXT),-1)
 +8        QUIT PSNEXT+1
 +9       ;
DOSPIECE(PSS) ;
 +1       ;@DESC Appends all pre-defined pieces to a temp var
 +2       ;@PSS The temp hash
 +3       ;@RETURNS The appended temp var.
 +4       ;
 +5       ;GCN
           SET PSS("I")=$PIECE(PSS("DoseValue"),"^",1)_"^"
 +6       ;Vuid
           SET PSS("I")=PSS("I")_$PIECE(PSS("DoseValue"),"^",2)_"^"
 +7       ;Ien
           SET PSS("I")=PSS("I")_$PIECE(PSS("DoseValue"),"^",3)_"^"
 +8       ;DrugName
           SET PSS("I")=PSS("I")_$PIECE(PSS("DoseValue"),"^",4)_"^"
 +9       ;CprsOrderNumber
           SET PSS("I")=PSS("I")_PSS("CprsOrderNumber")_"^"
 +10      ;Package
           SET PSS("I")=PSS("I")_PSS("Package")_"^"
 +11       SET PSS("I")=PSS("I")_PSS("Message")_"^"
 +12       SET PSS("I")=PSS("I")_PSS("ReasonCode")_"^"
 +13       SET PSS("I")=PSS("I")_PSS("ReasonSource")_"^"
 +14       SET PSS("I")=PSS("I")_PSS("ReasonText")
 +15       QUIT PSS("I")
 +16      ;
CHECKGCN(PSS,PSSHASH) ;
 +1       ;@DESC Checks the GCN for a Drug
 +2       ;@PSS A temp array
 +3       ;@PSSHASH The input array
 +4       ;@ASSERT PSS("DrugValue") exists.
 +5       ;
 +6        NEW DRUGNM,DRUGIEN,MESSAGE,REASON,BADGCN
 +7        SET PSS("Counter")="0"
 +8        if '$PIECE(PSS("DrugValue"),"^",1)
               Begin DoDot:1
 +9                SET DRUGIEN=$PIECE(PSS("DrugValue"),"^",3)
 +10               SET DRUGNM=$PIECE(PSS("DrugValue"),"^",4)
 +11               SET BADGCN=0
 +12               if $PIECE(PSS("DrugValue"),"^",1)'?1.N
                       SET BADGCN=-1
 +13               SET MESSAGE=$SELECT('$DATA(^TMP($JOB,"SAVE","IN","GCNMSG")):$$GCNREASN^PSSHRVL1(DRUGIEN,DRUGNM,PSS("PharmOrderNum"),BADGCN),1:"")
 +14               IF $LENGTH(MESSAGE)
                       SET REASON=$PIECE(MESSAGE,U,2,3)
                       SET MESSAGE=$PIECE(MESSAGE,U)
 +15               SET PSS("Counter")=$$NEXTGCN(.PSS,.PSSHASH)
 +16      ;Gcn
                   SET PSS("I")="^"
 +17      ;Vuid
                   SET PSS("I")=PSS("I")_$PIECE(PSS("DrugValue"),"^",2)_"^"
 +18      ;Ien
                   SET PSS("I")=PSS("I")_$PIECE(PSS("DrugValue"),"^",3)_"^"
 +19      ;DrugName
                   SET PSS("I")=PSS("I")_$PIECE(PSS("DrugValue"),"^",4)_"^"
 +20      ;CprsOrderNumber
                   SET PSS("I")=PSS("I")_$PIECE(PSS("DrugValue"),"^",5)_"^"
 +21      ;Package
                   SET PSS("I")=PSS("I")_$PIECE(PSS("DrugValue"),"^",6)_"^"
 +22               SET PSS("I")=PSS("I")_MESSAGE_"^"
 +23      ;Reason code is null for 0.5
 +24               SET PSS("I")=PSS("I")_PSSHASH("ReasonCode")_U
 +25      ;Set reason text
 +26               SET PSS("I")=PSS("I")_$$GETUCI^PSSHRVL1()_U
 +27               SET PSS("I")=PSS("I")_REASON
 +28      ;
 +29               DO SETEXCP(.PSS,.PSSHASH)
 +30               DO HDOSE(PSS("PharmOrderNum"))
                   DO KILLNODE^PSSHRVL1(PSSHASH("Base"),PSS("ProspectiveOrProfile"),PSS("PharmOrderNum"))
               End DoDot:1
 +31       QUIT 
 +32      ;
SETEXCP(PSS,PSSHASH) ;
 +1        SET PSSHASH("Exception",PSS("ProspectiveOrProfile"),PSS("PharmOrderNum"),PSS("Counter"))=PSS("I")
 +2        QUIT 
 +3       ;
DRUGPROF(PSSHASH) ;
 +1       ;@DESC Checks the profile drugs.
 +2       ;@PSSHASH The internal hash
 +3       ;
 +4        NEW PSS
 +5        SET PSS("ProspectiveOrProfile")="PROFILE"
 +6        SET PSS("PharmOrderNum")=""
 +7        FOR 
               SET PSS("PharmOrderNum")=$ORDER(^TMP($JOB,PSSHASH("Base"),"IN",PSS("ProspectiveOrProfile"),PSS("PharmOrderNum")))
               if PSS("PharmOrderNum")=""
                   QUIT 
               Begin DoDot:1
 +8                SET PSS("DrugValue")=^TMP($JOB,PSSHASH("Base"),"IN",PSS("ProspectiveOrProfile"),PSS("PharmOrderNum"))
 +9                DO CHECKGCN(.PSS,.PSSHASH)
 +10               QUIT 
               End DoDot:1
 +11       QUIT 
 +12      ;
 +13      ;
HDOSE(PSSDLDOS) ; If it's a Dose Call
 +1        IF '$DATA(^TMP($JOB,PSSHASH("Base"),"IN","DOSE",PSSDLDOS))
               QUIT 
 +2        DO KILLNODE^PSSHRVL1(PSSHASH("Base"),"DOSE",PSSDLDOS)
 +3        SET $PIECE(PSSDBCAR(PSSDLDOS),"^",13)=1
 +4        QUIT