NURCUT1.m

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 ---NURCUT1   845     printed  Apr 09, 2024@21:21:55                                                                                                                                                                                                      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