source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRCDCED.m@ 648

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

initial load of WorldVistAEHR
File size: 4.9 KB
Line 
1IMRCDCED ;HCIOFO/FT/FAI-FIELDS FOR EDITING CDC FORM ;12/26/01 13:36
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;**1,5,17,16**;Feb 09, 1998
3CDC ; [IMR CDC ENTER/EDIT] - CDC Form Data Entry
4 D EXIT S IMRNEW=0,IMRLOC="IMRCDCED"
5 D CHK^IMREDIT K IMRNEW G:DA'>0 EXIT
6 S IMRFN=DA,(IMRDFN,IMRP103)=+Y S DFN=+Y,IMRTSTLR=$P($G(^DPT(DFN,"LR")),U,1) D DEM^VADPT
7 S:'$D(^IMR(158,DA,1)) ^(1)="" I $P(^(1),U,34)'=2,VADM(6)>0 S $P(^IMR(158,DA,1),U,34)=2 ;piece 34=Patient Status (1=alive,2=dead,9=unknown)
8 K VA,VADM
9 D CDC1
10 D EXIT G CDC
11CDC1 ; called from from above and IMREDIT routine
12 W !!,"Select section of CDC form for editing:",!!?5," Patient ID Header (not edited)",!?5," Health Dept. Info (not edited)",!?5,"1. Demographic Information",!?5,"2. Facility of Diagnosis",!?5,"3. Patient History"
13 W !?5,"4. Laboratory Data",!?5," Other Header Data (not edited)",!?5,"5. Clinical Status",!?5,"6. Treatment/Services Referrals"
14 W !?5,"7. Comments",!?5,"8. The complete form (all of above)"
15 R !!,"Select section (1 to 8): ",X:DTIME
16 G:'$T!(X[U)!(X="") EXIT
17 I X'=+X!(X<1!(X>8)) W $C(7)," ??",!!,"Enter a number 1 to 8, or '^' or RETURN to quit" G CDC1
18 S IMRCDC=X
19 D:X<4!(X>4) ONSET
20 D:(IMRCDC=4!(IMRCDC=8)) TESTS
21 S IMRANS="" F IMRZ=1:1:7 I IMRZ=IMRCDC!(IMRCDC=8) D INPUT Q:IMRANS="^"
22 G CDC1
23 ;
24INPUT ; Entry Point to the seven Input Templates
25 ; CDC1 - Demographic information (III)
26 ; CDC2 - Facility of Diagnosis
27 ; CDC3 - Patient History (V)
28 ; CDC4 - Lab Data (VI)
29 ; CDC5 - Clinical Status (VIII)
30 ; CDC6 - Treatment/Services Referrals (IX)
31 ; CDC7 - CDC Additional info/comments
32 S DIE=158,X="IMR"_$P(" CDC1^ CDC2^ CDC3^ CDC4^ CDC5^ CDC6^ CDC7",U,IMRZ)
33 K DR S DR="["_X_"]" D ^DIE S:$D(Y)!($D(DTOUT)) IMRANS="^" Q:IMRANS="^"
34 K Y0 I IMRZ=5 D CDC5
35 Q
36ONSET ;
37 Q:'$D(DFN)
38 S VAPA("P")="" Q:DFN="" D ADD^VADPT,DEM^VADPT
39 S IMRSEX=$P($G(VADM(5)),U) K VA,VADM
40 I IMRCDC=4 K VAPA Q
41 S IMRCTYON=VAPA(4),IMRCONON="U.S.A.",IMRSON=$P(VAPA(5),U,1),IMRCOUON=$P(VAPA(7),U,2),IMRZON=VAPA(6) K VAPA
42 S IMRX=$S($D(^IMR(158,DA,1)):^(1),1:"")
43 S:$P(IMRX,U,10)="" $P(IMRX,U,10)=IMRCTYON ;city at onset of illness
44 S:$P(IMRX,U,11)="" $P(IMRX,U,11)=IMRCOUON ;county at onset
45 S:$P(IMRX,U,12)="" $P(IMRX,U,12)=IMRSON ;state at onset
46 S:$P(IMRX,U,13)="" $P(IMRX,U,13)=IMRCONON ;country at onset
47 S:$P(IMRX,U,14)="" $P(IMRX,U,14)=IMRZON ;zip code at onset
48 S ^IMR(158,DA,1)=IMRX
49 K IMRX,IMRCTYON,IMRCONON,IMRCOUON,IMRZON,IMRSON
50 Q
51TESTS ; Get last Elisa and Western Blot tests
52 D ^IMRTST
53 Q
54DX ; called from IMR CDC1 input template
55 S IMRX=$S($D(^IMR(158.9,1,4)):^(4),1:"")
56 S IMRY=$S($D(^IMR(158,DA,1)):^(1),1:"") S:'$D(^(2)) ^(2)=""
57 S:$P(^IMR(158,DA,2),U,54)="" $P(^(2),U,54)=$P(IMRX,U,6) ;hospital where aids diagnosed
58 S:$P(IMRY,U,16)="" $P(IMRY,U,16)=$P(IMRX,U,3) ;city where aids diagnosed
59 S:$P(IMRY,U,17)="" $P(IMRY,U,17)=$P(IMRX,U,4) ;state where diagnosed
60 S:$P(IMRY,U,18)="" $P(IMRY,U,18)="U.S.A" ;country where diagnosed
61 S ^IMR(158,DA,1)=IMRY
62 K IMRX,IMRY
63 Q
64CDC5 ; enter/edit diseases associated with patient
65 Q:'$D(^XUSEC("IMRA",DUZ))
66 W !!?10,"SELECT THE DISEASES THAT APPLY",!?10,"Enter 'N' to remove a disease incorrectly selected.",!!
67ASK ;
68 K IMRXA S IMRIX="7,8.2,7.1,8.3,102.15,8.4,7.2,8.5,7.3,102.16,7.4,8.6,7.5,8.7,7.6,8.8,7.7,102.17,7.8,8.9,7.9,9,8,9.1,8.1,9.2"
69 W !! S IMRK=0 F IMRII=1:2:25 D
70 . W ! S IMRK=IMRK+1 W $J(IMRK,2),". ",$P(^DD(158,+$P(IMRIX,",",IMRII),0),U) S IMRIJ=IMRII+1,IMRK=IMRK+1 W ?40,$J(IMRK,2),". ",$P(^DD(158,+$P(IMRIX,",",IMRIJ),0),U)
71 R !!?10,"Select Disease: ",X:DTIME Q:'$T G:X=""!(X[U) END I $E(X)="?" W !,"Enter the number or first couple of characters of the desired disease" G ASK
72 I X=+X,X>0,X<27 S IMRX=$P(IMRIX,",",X) G EDIT
73 I X=+X W $C(7)," ??" G ASK
74 I X?.E1L.E F I=1:1 S IMRXA=$E(X,I) Q:IMRXA="" I IMRXA?1L S IMRXA=$C($A(IMRXA)-32),X=$E(X,1,I-1)_IMRXA_$E(X,I+1,$L(X))
75 S IMRXJ=0 F I=1:1:26 S IMRXA=$P(^DD(158,+$P(IMRIX,",",I),0),U) I $E(IMRXA,1,$L(X))=X S IMRXJ=IMRXJ+1,IMRXA(IMRXJ)=I_U_IMRXA
76 I IMRXJ=0 W $C(7)," ??" G ASK
77 I IMRXJ=1 S X=$O(IMRXA(0)),X=+IMRXA(X),IMRX=$P(IMRIX,",",X) G EDIT
78 W !!,"Please select the desired disease by number:",! F I=1:1:IMRXJ W !,I," ",$P(IMRXA(I),U,2)
79 W !!?10,"Select (1 to ",IMRXJ,"): " R X:DTIME Q:'$T
80 I X'=+X!(X<1)!(X>IMRXJ) W $C(7)," ??",! G ASK
81 S X=+IMRXA(X),IMRX=$P(IMRIX,",",X) G EDIT
82 G ASK
83EDIT S IMRY=108+$S(X#2:(X+1/200),1:X/200+.13)
84 K DR S DIE=158,DR=IMRX_"R;I X=""N"" S Y=""@1"";"_IMRY_"R;S Y=""@2"";@1;"_IMRY_"///@;@2" D ^DIE K DR
85 G ASK
86END ; Print Diseases Currently Selected
87 D DISP^IMRCDPR
88 Q
89EXIT I $G(IMRNEW)'="" Q
90 K %,%T,%X,%Y,C,D0,DFN,DI,DIC,DIPGM,DNAM,DQ,DSC,DTAA,DTR1,DTR2,DTRC,DTRD,DTOUT,IMRANS,IMREDIT,IMRSTN,IMRXA,IMRXJ,IMRBLOT,IMRBLOTD,ILR,IMLM,IMLO,IMRDFN,IMRTSTI,IMRTSTII,IMS,IMWK,LDAT,LDO,LDT,LGN,LIG,LLOC,LNM,LRES,TNN,UNN,UNS
91 K IMRTSTLR,IMRFN,IMRSEX,IMRELISA,IMRELISD,DIE,DR,DA,IMRCDC,IMRII,IMRIJ,IMRIX,IMRLOC,IMRP103,IMRZ,I,J,K,X,X1,X2,IMRXN,Y,Y0,VAERR,DGA1,DGT,%DT,DISYS,DZ,POP
92 K IMRDATA,IMRXD,IMRX1,IMRD,IMRX,IMRSP,IMRXY,IMRCD,IMRCD4,IMRCD4D,IMRCD4E,IMRCD4X,IMRED1,IMRK,IMRPN,IMRPRC,IMRY,Y3,D,D1
93 Q
Note: See TracBrowser for help on using the repository browser.