source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRXOR.m@ 1006

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1IMRXOR ;ISC-SF/JLI,HCIOFO/FT-XOR ENCRYPTION FOR IMR POINTERS ;5/22/95 12:12
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;;Feb 09, 1998
3 I '$D(^XUSEC("IMRA",DUZ)) S IMRLOC="IMRXOR" D ACESSERR^IMRERR,H^XUS
4EN1 ; entry point from post-init
5 I '$D(IMRSTN) D IMROPN Q:'$D(IMRSTN)
6XOR S IMRXORZ="" I X'?1N.N S IMRXORZ=X,X="" F IMRXORY=0:0 S IMRXORX2=$E(IMRXORZ) Q:IMRXORX2'?1N S X=X_IMRXORX2,IMRXORZ=$E(IMRXORZ,2,99)
7 S (IMRXORX2,IMRXORX4)=+X,(IMRXORA,IMRXORB)=0,IMRXORN=7
8B17 S IMRXORM="0000^0001^0010^0011^0100^0101^0110^0111^1000^1001^1010^1011^1100^1101^1110^1111^"
9 S X=0 F IMRXORI=0:1 S IMRXOR2=IMRXORX2#16,IMRXORX2=IMRXORX2\16 D XOR1 S IMRXORB=IMRXORB+IMRXOR2 I (IMRXORB=IMRXORX4)&(IMRXORI>IMRXORN) Q
10 S X=X_IMRXORZ
11 K IMRXOR2,IMRXOR3,IMRXOR4,IMRXORM,IMRXORI,IMRXORA,IMRXORB,IMRXORJ,IMRXORX,IMRXORX2,IMRXORX4,IMRXORZ,IMRLOC,IMRXORN,IMRXORY
12 Q
13XOR1 ;
14 S IMRXOR3="1101",IMRXOR4=$P(IMRXORM,"^",IMRXOR2+1),IMRXORX="" F IMRXORJ=1:1:4 S IMRXORX=IMRXORX_($E(IMRXOR3,IMRXORJ)'=$E(IMRXOR4,IMRXORJ))
15 S IMRXORX=$F(IMRXORM,IMRXORX),IMRXORX=IMRXORX/5-1
16 I IMRXORI>0 F IMRXORJ=1:1:IMRXORI S IMRXORX=IMRXORX*16,IMRXOR2=IMRXOR2*16
17 S X=X+IMRXORX
18 Q
19IMROPN ;
20 I $D(^IMR(158.9,1,0)) S IMRSTN=$P(^(0),U),IMRSTN=$P(^DIC(4,+IMRSTN,99),U) Q
21 Q
22SPTNAME ; set logic for Activate 'Name' Pointer field
23 ; called from ^DD(158.9,.07,1,1,1)
24 Q:+$P($G(^IMR(158.9,D0,0)),U,7)=0
25 F IMRI=0:0 S IMRI=$O(^IMR(158,IMRI)) Q:IMRI'>0 S X=+^(IMRI,0) D IMRXOR I $D(^DPT(X,0)) S ^IMR(158,IMRI,103)=X,^IMR(158,"BP",X,IMRI)=""
26 K IMRI
27 Q
28KPTNAME ; kill logic for Activate 'Name' Pointer field
29 ; called from ^DD(158.9,.07,1,1,2)
30 F IMRI=0:0 S IMRI=$O(^IMR(158,IMRI)) Q:IMRI'>0 K ^(IMRI,103)
31 K ^IMR(158,"BP"),IMRI
32 Q
33A17 ;
34 S IMRXORZ="" I X'?1N.N S IMRXORZ=X,X="" F IMRXORY=0:0 S IMRXORX2=$E(IMRXORZ) Q:IMRXORX2'?1N S X=X_IMRXORX2,IMRXORZ=$E(IMRXORZ,2,99)
35 S (IMRXORX2,IMRXORX4)=+X,(IMRXORA,IMRXORB)=0,IMRXORN=4
36 G B17
Note: See TracBrowser for help on using the repository browser.