source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNLPIN.m@ 775

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

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1SPNLPIN ;ISC-SF/REM - INPUT/OUTPUT PROCESS FOR REGISTRANT ;10/25/2001
2 ;;2.0;Spinal Cord Dysfunction;**3,16**;01/02/1997
3 ;
4EN1 ;Enter/Edits a new registrant into the local registry.
5 N SPNLFLAG
6 S SPNLFLAG=0 K DIC
7 F D Q:SPNLFLAG=1
8 . S DIC="^SPNL(154,",DIC(0)="AELMQZ",DIC("A")="Select PATIENT: "
9 . S DLAYGO=154
10 . W ! D ^DIC K DIC I +Y<0 S SPNLFLAG=1 Q ;Lookup/adds entry.
11 . S DA=+Y I $P($G(Y),U,3)=1 D ;Will stuff defaults for new entries.
12 .. S DR=".03///SCD - CURRENTLY SERVED"
13 .. S DR=DR_";.05///NOW;.06///`"_DUZ
14 .. S DIE=154 D ^DIE K DIE
15 .. Q
16 . S DDSFILE=154,DR="[SPNLPFM1]" ;Invokes ScrnMan.
17 . S DDSPARM="C" D ^DDS
18 . K DDSPARM,DDSCHANG,CNT,SPNLTRIG,DR,DIE
19 . S DR=".05///NOW;.06///`"_DUZ,DIE=154 D ^DIE K DIE
20 . I $D(DIMSG) W !,"The screen-based entry process has failed!!",! Q
21 . K DDSPARM,DDSCHANG,CNT,SPNLTRIG,DR,DIE
22 . Q
23 K DA,DDSFILE,DR,DIC,Y,DIMSG,X,SPNLTRIG,CNT
24 Q
25INA ;Will inactivate registrant.
26 N SPNLNAME,SPNLRECN,SPNLFLAG
27 S SPNLRECN=0 F D Q:SPNLFLAG<0
28 .K DIC S DIC="^SPNL(154,",DIC(0)="AEMQZ"
29 .S DIC("A")="Select PATIENT: ",DIC("S")="I $P(^(0),U,3)=1"
30 .W ! D ^DIC S SPNLFLAG=Y K DIC Q:SPNLFLAG<0
31 .S SPNLRECN=+Y,SPNLNAME=Y(0,0)
32 .W *7 S DIR(0)="Y",DIR("A")=" Are you sure you want "_SPNLNAME_" inactive",DIR("B")="NO" D ^DIR K DIR
33 .I Y=1 S DR=".03///SCD - NOT CURRENTLY SERVED",DIE=154,DA=SPNLRECN D ^DIE K DIE W !," "_SPNLNAME_" is now inactive.",! Q
34 .I Y=0 W !," NOTHING HAS BEEN DONE.",*7,!
35 K Y,X,DA,DR,DIE
36 Q
37ACT ;Will activate registrant.
38 N SPNLNAME,SPNLRECN,SPNLFLAG,SPNFLG
39 S SPNFLG=0
40 S SPNLRECN=0 F S SPNLRECN=$O(^SPNL(154,SPNLRECN)) Q:SPNLRECN<1 D Q:SPNFLG
41 .I $P($G(^SPNL(154,SPNLRECN,0)),U,3)=2 S SPNFLG=1
42 .Q
43 I SPNFLG S SPNLRECN=0 F D Q:SPNLFLAG<0
44 .K DIC S DIC="^SPNL(154,",DIC(0)="AEMQZ"
45 .S DIC("A")="Select PATIENT: ",DIC("S")="I $P(^(0),U,3)=2"
46 .W ! D ^DIC S SPNLFLAG=Y K DIC Q:SPNLFLAG<0
47 .S SPNLRECN=+Y,SPNLNAME=Y(0,0)
48 .W *7 S DIR(0)="Y",DIR("A")=" Are you sure you want "_SPNLNAME_" active",DIR("B")="NO" D ^DIR K DIR
49 .I Y=1 S DR=".03///SCD - CURRENTLY SERVED",DIE=154,DA=SPNLRECN D ^DIE K DIE W !," "_SPNLNAME_" is now active.",! Q
50 .I Y=0 W !," NOTHING HAS BEEN DONE.",*7,!
51 E W !,"There are no INACTIVE patient in the SCD Registry."
52 K Y,X,DA,DR,DIE
53 Q
54PRT1 ;Print report of registrant's general information from file 154.
55 N SPNLEXIT,SPNLTMP
56 S SPNLEXIT=0 D EN1^SPNPRTMT Q:SPNLEXIT ;Filters
57 D EN^SPNLRU1 I $G(ABORT)=1 D END Q
58 S DIS(0)="I $$TRAUMA^SPNLRU1(D0),$$EN2^SPNPRTMT(D0)"
59 I $D(SPNLTRM1) S DHD="SCD Registrant General Report ("_SPNLTRM1_")"
60 M SPNLTMP=^TMP($J,"SPNPRT")
61 S DIOBEG="K ^TMP($J,""SPNPRT"") M ^TMP($J,""SPNPRT"")=SPNLTMP K DIOBEG"
62 S DIOEND="K ^TMP($J,""SPNPRT""),DIOEND"
63 K DIC S DIC=154,L=0,FLDS="[SPNLPT1]" D EN1^DIP S DIR(0)="E" D ^DIR
64 D END Q
65PRT2 ;Print report of registrant's injury information from file 154.
66 N SPNLEXIT,SPNLTMP
67 S SPNLEXIT=0 D EN1^SPNPRTMT Q:SPNLEXIT ;Filters
68 D EN^SPNLRU1 I $G(ABORT)=1 D END Q
69 S DIS(0)="I $$TRAUMA^SPNLRU1(D0),$$EN2^SPNPRTMT(D0)"
70 I $D(SPNLTRM1) S DHD="SCD Registrant General Report ("_SPNLTRM1_")"
71 M SPNLTMP=^TMP($J,"SPNPRT")
72 S DIOBEG="K ^TMP($J,""SPNPRT"") M ^TMP($J,""SPNPRT"")=SPNLTMP K DIOBEG"
73 S DIOEND="K ^TMP($J,""SPNPRT""),DIOEND"
74 K DIC S DIC=154,L=0,FLDS="[SPNLPT2]" D EN1^DIP S DIR(0)="E" D ^DIR
75END ;
76 K DIC,L,FLDS,DIR,ABORT,SPNLTRAM,SPNLTRM1,SPNTD,DHD,SPNCAUSE,SPND1,SPNETIOL
77 Q
Note: See TracBrowser for help on using the repository browser.