NURCUT1 ;HIRMFO/RM-UTILITIES FOR CLINICAL NURSING ;APR 4, 1994
;;4.0;NURSING SERVICE;**18**;Apr 25, 1997
ALLERGY(DFN,ARRAY) ; PROCEDURE RETURNS PT A/AR INFO
; INPUT: DFN=PTR TO PATIENT
; ARRAY=RESULTS RETURNED IN ARRAY (PASSED BY REF)
; OUTPUT: ARRAY(X)=A
; WHERE X IS 1..NUMBER OF ALLERGIES
; A IS FREE TEXT ALLERGY (MECHANISM)
N GMRAL,CTR,LPV K ARRAY
S X="GMRADPT" X ^%ZOSF("TEST") I $T D EN1^GMRADPT S ARRAY=GMRAL
I $O(GMRAL(0)) D
. S CTR=0
. S LPV=0 F S LPV=$O(GMRAL(LPV)) Q:LPV'>0 D
. . S CTR=CTR+1
. . S ARRAY(CTR)=$P(GMRAL(LPV),"^",2)_$P(" (allergy)^ (adv rxn)","^",$F("01",$P(GMRAL(LPV),"^",5))-1)
. . Q
. Q
Q
DX(DFN,DATE) ; PROCEDURE RETURNS PT DX INFO
; INPUT: DFN=PTR TO PATIENT
; DATE=DATE TO FIND CURRENT DX FOR
; OUTPUT:
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCUT1 845 printed Dec 13, 2024@02:20:57 Page 2
NURCUT1 ;HIRMFO/RM-UTILITIES FOR CLINICAL NURSING ;APR 4, 1994
+1 ;;4.0;NURSING SERVICE;**18**;Apr 25, 1997
ALLERGY(DFN,ARRAY) ; PROCEDURE RETURNS PT A/AR INFO
+1 ; INPUT: DFN=PTR TO PATIENT
+2 ; ARRAY=RESULTS RETURNED IN ARRAY (PASSED BY REF)
+3 ; OUTPUT: ARRAY(X)=A
+4 ; WHERE X IS 1..NUMBER OF ALLERGIES
+5 ; A IS FREE TEXT ALLERGY (MECHANISM)
+6 NEW GMRAL,CTR,LPV
KILL ARRAY
+7 SET X="GMRADPT"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO EN1^GMRADPT
SET ARRAY=GMRAL
+8 IF $ORDER(GMRAL(0))
Begin DoDot:1
+9 SET CTR=0
+10 SET LPV=0
FOR
SET LPV=$ORDER(GMRAL(LPV))
if LPV'>0
QUIT
Begin DoDot:2
+11 SET CTR=CTR+1
+12 SET ARRAY(CTR)=$PIECE(GMRAL(LPV),"^",2)_$PIECE(" (allergy)^ (adv rxn)","^",$FIND("01",$PIECE(GMRAL(LPV),"^",5))-1)
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 QUIT
DX(DFN,DATE) ; PROCEDURE RETURNS PT DX INFO
+1 ; INPUT: DFN=PTR TO PATIENT
+2 ; DATE=DATE TO FIND CURRENT DX FOR
+3 ; OUTPUT:
+4 QUIT
