| 1 | RADEM ;HISC/CAH AISC/MJK,RMO,DMK-Display Patient Demographics ;1/22/97 11:10
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;**31**;Mar 16, 1998
|
|---|
| 3 | PAT G Q:'$D(^DPT(RADFN,0)) S Y=^(0),RANME=$P(Y,"^"),RASEX=$S($P(Y,"^",2)="M":"MALE",$P(Y,"^",2)="F":"FEMALE",1:"Unknown"),RASSN=$$SSN^RAUTL,RADOB=$P(Y,"^",3),X1=DT,X2=RADOB D ^%DTC S RAGE=X\365.25
|
|---|
| 4 | S:$E(DT,4,7)=$E(RADOB,4,7) RAGE=RAGE+1 ;today is birthday
|
|---|
| 5 | S Y=RADOB D D^RAUTL S RADOB=Y
|
|---|
| 6 | ; obtain patient address data
|
|---|
| 7 | K VAERR,RAPA S DFN=RADFN,VAROOT="RAPA" D ADD^VADPT K VAROOT
|
|---|
| 8 | I VAERR D ; Error, invalid DFN or corrupt ^DPT(DFN,0) node
|
|---|
| 9 | . F RAI=1:1:3 S RAPA(RAI)="Unknown"
|
|---|
| 10 | . S RATWN="Unknown",RAPA(8)="Unknown"
|
|---|
| 11 | . Q
|
|---|
| 12 | I 'VAERR D
|
|---|
| 13 | . S RATWN=$G(RAPA(4))_", "_$P($G(^DIC(5,+$G(RAPA(5)),0)),U,2)_" "_$G(RAPA(6))
|
|---|
| 14 | . Q
|
|---|
| 15 | N RAVETELI S RAVETELI=$$VETELI^RADEM2(RADFN)
|
|---|
| 16 | S RAVET=$P(RAVETELI,"^"),RAELIG=$E($P(RAVETELI,"^",2),1,25)
|
|---|
| 17 | S (RAMED,RAUSAL)="Unknown" S Y=$$ORCHK^GMRAOR(RADFN,"CM") S RAMED=$S(Y=1:"Yes",Y=0:"No",1:RAMED)
|
|---|
| 18 | I $D(^RADPT(RADFN,0)) S Y=^(0) D
|
|---|
| 19 | . S RAUSAL=$P($P(^DD(70,.04,0),$P(Y,"^",4)_":",2),";")
|
|---|
| 20 | . S:RAUSAL']"" RAUSAL="Unknown"
|
|---|
| 21 | . Q
|
|---|
| 22 | I $D(^DPT(RADFN,.1)),^(.1)]"" D ^RASERV
|
|---|
| 23 | DIS D HOME^%ZIS W @IOF," *********** Patient Demographics ***********",!
|
|---|
| 24 | W !?2,"Name : ",$E(RANME,1,20),?40,"Address: ",?50,$G(RAPA(1))
|
|---|
| 25 | W !?2,"Pt ID : ",RASSN,?38,$S($G(RAPA(9))]"":"(temporary)",1:""),?50,$G(RAPA(2))
|
|---|
| 26 | W !?2,"Date of Birth: ",RADOB,?50,$G(RAPA(3))
|
|---|
| 27 | W !?2,"Age : ",RAGE,?50,$G(RATWN)
|
|---|
| 28 | W !?2,"Veteran : ",RAVET W:$D(RAWARD) ?40,"Currently is an inpatient."
|
|---|
| 29 | W !?2,"Eligibility : ",RAELIG W:$D(RAWARD) ?42,"Ward : ",RAWARD
|
|---|
| 30 | W !?2,"Exam Category: ",RAUSAL W:$D(RASER) ?42,"Service : ",RASER
|
|---|
| 31 | W !?2,"Sex : ",RASEX W:$D(RABED) ?42,"Bedsection : ",RABED
|
|---|
| 32 | W !?2,"Phone Number : ",$G(RAPA(8))
|
|---|
| 33 | I $D(^RADPT(RADFN,1)) W !?2,"Narrative : ",^(1)
|
|---|
| 34 | W !!?2,"Contrast Medium Reaction: ",RAMED
|
|---|
| 35 | W !,?2,"Other Allergies:",!?7,"'V' denotes verified allergy 'N' denotes non-verified allergy",!
|
|---|
| 36 | S DFN=RADFN D ALLERGY I '$D(GMRAL) W !?20,"** No allergies on file **" G Q
|
|---|
| 37 | S RAXIT=0 F I=1:1 Q:'$D(PI(I))!RAXIT D
|
|---|
| 38 | . W:I#2 !?2,PI(I) W:I#2=0 ?40,PI(I)
|
|---|
| 39 | . I $E(IOST,1,2)="C-",($Y>(IOSL-7)),$D(PI(I+1))#2,(I#2=0) D
|
|---|
| 40 | .. N DIR S DIR(0)="E" D ^DIR S RAXIT=$S(Y'>0:1,1:0) Q:RAXIT
|
|---|
| 41 | .. W @IOF,!,?2,"Other Allergies:",!?7,"'V' denotes verified allergy 'N' denotes non-verified allergy",!
|
|---|
| 42 | .. Q
|
|---|
| 43 | . Q
|
|---|
| 44 | I RAXIT G Q^RADEM1
|
|---|
| 45 | Q I $D(^DPT(RADFN,.35)),$P(^(.35),"^") W !!?2,$C(7),"**** Patient has died ****" H 3
|
|---|
| 46 | K %,%H,POP,RATWN,RASEX,RAWD,PI,RADOB,RAELIG,RAGE,RAI,RAMED,RANME,RAPA
|
|---|
| 47 | K RASER,RASSN,RAUSAL,RAVET,RAWARD,ST,I,VAIN,VAERR,RABED,GMRAL G ^RADEM1
|
|---|
| 48 | ;
|
|---|
| 49 | RADFN S DIC="^DPT(",DIC(0)="AEMQ" D ^DIC K DIC Q:Y<0 S RADFN=+Y G PAT
|
|---|
| 50 | ;
|
|---|
| 51 | ALLERGY ;get allergies DFN must be defined
|
|---|
| 52 | ;returns PI(CNT)
|
|---|
| 53 | S X="GMRADPT" X ^%ZOSF("TEST") Q:'$T
|
|---|
| 54 | N I,CNT
|
|---|
| 55 | Q:'$D(DFN) D ^GMRADPT Q:'$D(GMRAL)
|
|---|
| 56 | S (I,CNT)=0
|
|---|
| 57 | F S I=$O(GMRAL(I)) Q:'I I $P(GMRAL(I),"^",2)]"" S CNT=CNT+1,PI(CNT)=$E($P(GMRAL(I),"^",2),1,35) D
|
|---|
| 58 | .S PI(CNT)=PI(CNT)_"("_$S($P(GMRAL(I),"^",4)=1:"V",1:"N")_")" Q
|
|---|
| 59 | Q
|
|---|
