source: WorldVistAEHR/trunk/r/OPERATIONS_WITH_DESERT_STORM-A1B2/A1B2Q.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1A1B2Q ;JLU/ALB; National inquiry of patients; 1/13/90
2 ;;Version 1.55 (local for MAS v5 sites);;
3ADD W !!,"Address:"
4 I A1B2A1'="" W ?9,A1B2A1,!
5 I A1B2A2'="" W ?9,A1B2A2,!
6 I A1B2A3'="" W ?9,A1B2A3,!
7 W ?9,$S(A1B2A4'="":A1B2A4,1:"")," ",$S(A1B2A5'="":A1B2A5,1:"")," ",$S(A1B2A6'="":A1B2A6,1:"")
8 Q
9PG D HOME^%ZIS W @IOF
10 Q
11 ;
12ST ;For end of screen.
13 S DIR(0)="E" D ^DIR S A1B2E=Y
14 I A1B2E D PG
15 Q
16 ;
17B ;Entry point for inquiry display.
18 S A1B2X=^A1B2(11500.1,A1B2Y,0)
19 I $D(^A1B2(11500.1,A1B2Y,.11)) S A1B2X1=^(.11),A1B2A1=$P(A1B2X1,U,1),A1B2A2=$P(A1B2X1,U,2),A1B2A3=$P(A1B2X1,U,3),A1B2A4=$P(A1B2X1,U,4),A1B2A5=$S($P(A1B2X1,U,5):$P(^DIC(5,$P(A1B2X1,U,5),0),U),1:""),A1B2A6=$P(A1B2X1,U,6)
20 S A1B2SS=$P(A1B2X,U),A1B2NA=$P(A1B2X,U,2),A1B2DB=$P(A1B2X,U,3),A1B2BS=$P(A1B2X,U,4),A1B2RA=$P(A1B2X,U,5),A1B2CD=$S($P(A1B2X,U,7)="S":"Seriously Ill",1:"")
21 I A1B2RA S A1B2RA=$P(^DIC(25002.1,A1B2RA,0),U)
22 I A1B2DB S (X2,Y)=A1B2DB D DD^%DT S A1B2DB=Y,X1=DT D ^%DTC S A1B2AG=X\365.25
23 I A1B2BS S A1B2BS=$P(^DIC(23,A1B2BS,0),U)
24 F A1B2LP=0:0 S A1B2LP=$O(^A1B2(11500.2,"C",A1B2Y,A1B2LP)) Q:'A1B2LP S Y1=^A1B2(11500.2,A1B2LP,0) I $P(Y1,U,15) D AD
25 F A1B2LP=0:0 S A1B2LP=$O(^A1B2(11500.4,"C",A1B2Y,A1B2LP)) Q:'A1B2LP S Y1=^A1B2(11500.4,A1B2LP,0) I $P(Y1,U,15) D RD
26 Q
27 ;
28AD S A1B2AS=$P(Y1,U,3)
29 ;FAC^DT AD^AD SP^DC DT^DC SP^TRAN TO^TRAN TY
30 S X=U_+Y1_U_$S(A1B2AS:$P(^DIC(42.4,A1B2AS,0),U),1:"")_U_$P(Y1,U,6)_U_$S($P(Y1,U,5):$P(^DG(405.2,$P(Y1,U,5),0),U),1:"")_U_$P(Y1,U,10)_U_$P(Y1,U,11)
31 X ^DD("FUNC",14,1) S $P(X,U)=$P(Y1,U,8),A1B2AD(9999999-+Y1)=X
32 Q
33 ;
34RD S A1B2DP=$P(Y1,U,5)
35 S X=U_+Y1_U_$S(A1B2DP:$P(^DIC(37,A1B2DP,0),U),1:"")
36 X ^DD("FUNC",14,1) S $P(X,U)=$P(Y1,U,8),A1B2RD(9999999-+Y1)=X
37 Q
38 ;
39C ;Entry point for display.
40 D PG,HD1
41 W !!,"Patient: ",A1B2NA I A1B2CD'="",$S('$D(A1B2NTY):1,1:$P(A1B2NTY,U,3)) W ?45,"*** ",A1B2CD," ***"
42 W !,?4,"SSN: ",A1B2SS,?41,"Service Branch: ",$E(A1B2BS,1,23)
43 W !,?4,"DOB: ",A1B2DB,?51,"Rank: ",A1B2RA
44 W !,?4,"Age: ",$S($D(A1B2AG):A1B2AG,1:"")
45 I $D(A1B2NTY),$D(A1B2X1) D ADD
46 ;Came from A1B2ZUTL to display
47 I $D(A1B2ZU) D EX Q
48 S A1B2L="- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - "
49 S A1B2E=1
50 I $D(A1B2AD) W !,A1B2L F A1B2LP=0:0 S A1B2LP=$O(A1B2AD(A1B2LP)) Q:'A1B2LP D:$Y>(IOSL-5) ST Q:'A1B2E D WA
51 I $D(A1B2RD) W !!,A1B2L F A1B2LP=0:0 S A1B2LP=$O(A1B2RD(A1B2LP)) Q:'A1B2LP D:$Y>(IOSL-5) ST Q:'A1B2E D WR
52 W !!!
53 Q
54 ;
55WA W !!,"Admitted to ",$S($L($P(A1B2AD(A1B2LP),U))>2:$E($P(A1B2AD(A1B2LP),U),1,26),1:"UNKNOWN")," on "
56 S Y=$P(A1B2AD(A1B2LP),U,2) D DT^DIO2 W " to ",$P(A1B2AD(A1B2LP),U,3)
57 I $L($P(A1B2AD(A1B2LP),U,4))>2 W !," Discharged from ",$S($L($P(A1B2AD(A1B2LP),U))>2:$E($P(A1B2AD(A1B2LP),U),1,26),1:"UNKNOWN")," on "
58 I $L($P(A1B2AD(A1B2LP),U,4))>2 S Y=$P(A1B2AD(A1B2LP),U,4) D DT^DIO2 W " for ",$P(A1B2AD(A1B2LP),U,5)
59 I $L($P(A1B2AD(A1B2LP),U,6))>2 W !," Transferred to ",$P(A1B2AD(A1B2LP),U,6),$S($P(A1B2AD(A1B2LP),U,7)=0:" (VAMC)",1:" (UNKNOWN)")
60 Q
61 ;
62WR W !!,"Registered at ",$S($L($P(A1B2RD(A1B2LP),U))>2:$E($P(A1B2RD(A1B2LP),U),1,26),1:"UNKNOWN")," on "
63 S Y=$P(A1B2RD(A1B2LP),U,2) D DT^DIO2 W " for ",$P(A1B2RD(A1B2LP),U,3)
64 Q
65 ;
66HD1 ;Header for inquiry report.
67 W !,?25,"*** ODS Patient Inquiry ***"
68 ;;;W !,"------------------------------------------------------------------------------"
69 Q
70 ;
71EX ;Kill point.
72 K DIC,A1B2X,A1B2SS,A1B2NA,A1B2DB,A1B2BS,A1B2AD,A1B2RD,A1B2DP,A1B2AS,Y,A1B2LP,A1B2Y,A1B2E,A1B2RA,DIR,Y1,A1B2CD,A1B2Y3,Y2,Y3,A1B2A1,A1B2A2,A1B2A3,A1B2A4,A1B2A5,A1B2A6,A1B2X1,X,A1B2L,A1B2AG
73 Q
74 ;
75A ;Entry point for inquiry lookup.
76 S DIC="^A1B2(11500.1,",DIC(0)="AEMQ",DIC("A")="Select Patient: "
77 S DIC("S")="I $P(^(0),U,8)=1 N X S X=$S($D(A1B2NTY):$P(A1B2NTY,U,2),1:"""") I $S(X=""""!(X=""A""):1,X=""V"":$D(^A1B2(11500.1,+Y,""NET"",""B"",+A1B2FN))>9,X=""R"":$D(^A1B2(11500.1,+Y,""NET"",""AR"",+A1B2VRG))>9,1:0)"
78 D ^DIC K DIC I 'Y!(Y<0) Q
79 S A1B2Y=+Y
80 D B,C,EX G A
Note: See TracBrowser for help on using the repository browser.