source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMREDIT.m@ 975

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1IMREDIT ;HCIOFO/FAI - PT LOOKUP IN IMR FILE ;11/07/01 10:46;
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;**9,5,13,17,16**;Feb 09, 1998;
3EDIT ; [IMR ENTER/EDIT DATA] - Enter/Edit Basic Patient Data
4EDIT1 D KILL
5 S IMRNEW=1 D CHK K IMRNEW G:DA'>0 EXIT
6 K IMRCD4,IMRCDC,IMRCD4D,IMRCD4X,IMRCD,IMRLCD,IMRLCDD,IMRCDX,IMRCDXD,IMRED1
7 S IMRFN=DA,DFN=+Y,IMRTSTLR=$P($G(^DPT(DFN,"LR")),U,1)
8FILO S IMRANS="" D ^IMRLTST W !! D EDIT^IMRCD4 ;list and edit CD4 values
9 I IMRANS="^" D KILL G EDIT1
10 K DR,IMRPN S DIE=158,DR="[IMR EDIT1]" D ^DIE ;edit station,patient status country of birth,...etc)
11 K IMRCD4,IMRCD4D,IMRCD4X,IMRLCD,IMRLCDD,IMRCDX,IMRCDXD,IMRED1
12 S:$D(IMRDFN) DFN=IMRDFN
13 S DIR(0)="Y",DIR("A")="Do you want to Enter/Edit CDC form data now"
14 D ^DIR K DIR
15 I Y D CDC1^IMRCDCED
16 I $G(IMRNEW)'="" D FINCHK
17 D KILL G EDIT1
18CHK ; Check Station
19 I '$D(^XUSEC("IMRA",DUZ)) S:'$D(IMRLOC) IMRLOC="IMREDIT" D ACESSERR^IMRERR,H^XUS K IMRLOC
20 D:'$D(IMRSTN) IMROPN^IMRXOR
21ASK ; Select Patient
22 S:'$D(IMRNEW) IMRNEW=0
23 W !! K DIC S DIC=2,DIC(0)="AEQM" D ^DIC S (X,DA)=+Y Q:Y'>0
24 D ^IMRXOR
25 I '$D(^IMR(158,"B",X)) S DA=-1 I IMRNEW S DA=+Y D NEW I '$D(X) G ASK
26 I DA'>0 W !,$C(7),"This patient must be entered into the Immunology Case Study file using",!,"The Enter/Edit option first.",!! G ASK
27 S Y=DA,DA=+$O(^IMR(158,"B",X,0)) G:DA'>0 ASK
28 Q
29NEW ; add new entry to ICR database
30 R !?5,"Is this patient REALLY supposed to be in your database (Y/N)?",Y:DTIME
31 G:'$T!(Y["U") EXIT
32 I "YyNn"'[$E(Y) W $C(7)," ??" G NEW
33 I "Nn"[$E(Y) K X S DA=-1 Q
34 S IMRX=X,(NPFN,IMRDFN,DFN)=DA,IMRTSTLR=$P($G(^DPT(DFN,"LR")),U,1) D DEM^VADPT
35 S X=IMRX,DIC=158,DIC(0)="L",DLAYGO=158 D ^DIC K DLAYGO S IMNN=+Y G:Y'>0 EXIT
36 S X=$P($G(VADM(8)),U) I X>0 S X=$S($D(^DIC(10,X,0)):$P(^(0),U,2),1:0) I X>0 S $P(^IMR(158,+Y,0),U,2)=$S(X=1:3,X=2:3,X=3:5,X=4:2,X=5:4,X=6:1,1:9)
37 S ^IMR(158,+Y,101)="" I $P($G(^IMR(158.9,1,0)),U,7)>0 S ^IMR(158,+Y,103)=DA ; set active name pointer
38 S X=IMRX
39 S IMRFN=+Y,IMRP103=DFN,IMRTSTLR=$P($G(^DPT(NPFN,"LR")),U,1)
40 S Y=DA,DA=+$O(^IMR(158,"B",X,0)) G:DA'>0 ASK
41 G FILO
42 Q
43FINCHK W !!,"Are you sure, "_$P($G(^DPT(IMRDFN,0)),U,1)_" should be"
44 R " in your database (Y/N)?",Y:DTIME
45 G:'$T!(Y["U") EXIT
46 I "YyNn"'[$E(Y) W $C(7)," ??" G FINCHK
47 I "Nn"[$E(Y) S DIK="^IMR(158,",DA=IMRX D ^DIK K DIK D KILL G EDIT
48 W !!,?5,"Sending the past 365 days of data to the HIV National Database..",!! H 1
49 D ^IMRBPT
50 S IMRTSTLR=$P($G(^DPT(NPFN,"LR")),U,1)
51 Q
52EXIT D KILL
53 Q
54KILL K %ZIS,DA,DIC,DIE,IMRCD,IMRCD4,IMRCDC,IMRFLG,IMRL,IMRN1,IMRN2,IMRN3,IMRP103,IMRX,I,J,POP,X,Y,Y1,Y2,IMRPT,IMRSTN,Y0,IMRDFN,IMREDIT,IMRXCAT,IMRCD4E,D0,DI,DIPGM,DR,VAERR,CNUM,CPTC,CPTREC,D2,DDER,DDH,DGMT,DGMTE,DGNOCOPF,DGWRT,IMNN,IMRFB,IMRFLAG
55 K %,%DT,%X,%Y,C,CDAR,CDP,D0,D1,DA,D,DIC,DIE,DNAM,DQ,DR,DTAA,DTR1,DTR2,DTRC,DTRD,HVR,ILR,IMDATE,IMLM,IMLO,IMRANS,IMRANS,IMRCD,IMRDFN,IMRFN,IMRLNODE,IMRLTEST,IMRNEW,IMRSTN,IMRTSTI,IMRTSTII,IMRTSTLR,IMRVLIEN,IMS,IMWK,IMRPR4,IMRPRC,IMRY1
56 K IMRNEW,IMRSTN,DFN,LCDD,LDAT,LDO,LDT,LGN,LIG,LL,LLOC,LNM,LOWP,LRES,MDT,PLOW,RC,TNN,UNN,UNS,IMRI,IMRLABTR,IMRSUF,IPC,NPFN,SDCNT
57 Q
58IMRDEV ; Select Device from ALLOWABLE PRINTER multiple in File 158.9
59 ; If no allowable printers select any printer
60 ; If a slave device is selected, then don't display the entries
61 ; from the ALLOWABLE PRINTER multiple
62IMRDEV1 ;
63 S IMRFLG=0
64 I $O(^IMR(158.9,1,7,0))'>0 S IOP="Q",%ZIS="MPQ" D ^%ZIS Q:POP S IMRFLG=1
65 I $D(IO("S")) S IMRFLG=1 ; check if slave device chosen
66 I 'IMRFLG W !!,$C(7),"Select *SECURE* ALLOWABLE PRINTERS (Field 7) from ICR Site Parameters File:",!?5,"HOME" F I=0:0 S I=$O(^IMR(158.9,1,7,I)) Q:I'>0 I $D(^(I,0)) S X=+^(0) I $D(^%ZIS(1,X,0)) W !?5,$P(^(0),U)
67 I 'IMRFLG W ! S IOP="Q",%ZIS="MPQ" D ^%ZIS Q:POP S IMRFLG=1 I IO'=IO(0) S IMRFLG=0 F I=0:0 S I=$O(^IMR(158.9,1,7,I)) Q:I'>0 I $D(^(I,0)) S X=+^(0) I $D(^%ZIS(1,X,0)) I $P(ION,";",1)=$P(^(0),U) S IMRFLG=1 Q
68 I 'IMRFLG W !,"Select one of the valid devices",$C(7),! G IMRDEV1
69 Q
Note: See TracBrowser for help on using the repository browser.