source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNFRMU.m@ 1458

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

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1SPNFRMU ;WDE-SD/ ON THE FLY CREATION OF ADMISSION DATES ;12-16-99
2 ;;2.0;Spinal Cord Dysfunction;**12**;01/02/1997
3 ;called from spnfedt0.
4 ;
5BLD ;New load for the temp storage field data
6 S U="^"
7 S SPNDFN=$P($G(^SPNL(154.1,DA,0)),U,1)
8 Q:SPNDFN="" Q:'+SPNDFN
9 S SPNDA=DA N DA
10 S SPX=0 F SPZ=1:1 S SPX=$O(^DGPM("ATID1",SPNDFN,SPX)) Q:(SPX="")!('+SPX) D
11 .S SPNADM=0,SPNADM=$O(^DGPM("ATID1",SPNDFN,SPX,SPNADM))
12 .S Y=$P($G(^DGPM(SPNADM,0)),U,1)
13 .Q:Y=""
14 .K DD
15 .S DIC="^SPNL(154.991,",DIC(0)="LNX",X=Y,DINUM=X,DIC("DR")="1///^S X=SPNDA;2///^S X=SPNDFN"
16 .D FILE^DICN
17 .Q
18 K DIC,SPNDA,SPNADM,SPZ,SPX,Y
19 Q
20KILL ;
21 S SPNDA=DA N DA
22 S DIK="^SPNL(154.991,"
23 S SPX=0 F S SPX=$O(^SPNL(154.991,SPX)) Q:'+SPX D
24 .I $P(^SPNL(154.991,SPX,0),U,2)=SPNDA S DA=SPX D ^DIK
25 .Q
26 K DIK,SPNDA,SPX
27 Q
28DISP ;this line tag is called from spnfedt0.
29 ;it is used to set up the call to display data on LooK-up into 154.1
30 ;It will display the adm date/score type/and edss socore for ms records
31 S SPNY=Y
32 S SPNDISP=""
33 S SPDTA=$G(^SPNL(154.1,SPNY,2))
34 S SPNDISP="Admission: "
35 S SPNTMP=$P(SPDTA,U,18) I +SPNTMP S SPNTMP=$$FMTE^XLFDT(SPNTMP,"5ZDP") S SPNDISP=SPNDISP_SPNTMP
36 I SPNTMP="" S SPNDISP=SPNDISP_" "
37 S SPNDISP=SPNDISP_" Score type: "
38 S SPNTMP=$P(SPDTA,U,17)
39 S SPNTMP=$S(SPNTMP=1:"Admission ",SPNTMP=2:"Goal ",SPNTMP=3:"Interim ",SPNTMP=4:"Discharge",SPNTMP=5:"OutPatient",1:" ")
40 S SPNDISP=SPNDISP_SPNTMP
41 S SPNTMP=$P($G(^SPNL(154.1,SPNY,"MS")),U,9)
42 I SPNTMP="" K SPNTMP,SPDTA S:$P($G(^SPNL(154.1,SPNY,0)),U,2)=4 SPNDISP=SPNDISP_" EDSS Score: " S Y=SPNY Q ;No edss score
43 S SPNDISP=SPNDISP_" EDSS Score: "
44 S SPNTMP=$P($G(^SPNL(154.2,SPNTMP,0)),U,1)
45 I SPNTMP="" S SPNTMP=" "
46 S SPNDISP=SPNDISP_SPNTMP
47 K SPNTMP,SPDTA
48 K SPNY
49 Q
Note: See TracBrowser for help on using the repository browser.