source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCHIS.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.1 KB
RevLine 
[613]1VAFCHIS ;SF/CMC-TESTING CROSS REFERENCE ;11/20/97
2 ;;5.3;Registration;**149,255,307,711**;Aug 13, 1993
3 ;
4 ; Integration Agreements Utilized:
5 ; CHECKDG^MPIFSPC - #3158
6 ;
7ICN(OLD,ENT) ;
8 ;
9 I '$D(OLD)!('$D(ENT)) Q
10 N NEWICN,DIC,Y
11 ;checking that CIRN PD/MPI is installed
12 N X S X="MPIF001" X ^%ZOSF("TEST") Q:'$T
13 N X S X="MPIFAPI" X ^%ZOSF("TEST") Q:'$T
14 N X S X="MPIFMER" X ^%ZOSF("TEST") Q:'$T
15 S NEWICN=+$$GETICN^MPIF001(ENT)
16 Q:OLD=NEWICN!(OLD="")
17 ; ^ UPDATE ICN WITH SAME ICN DON'T PUT IT IN HISTORY
18 ;
19 S OLDDA=DA,OLDX=OLD
20 N DA
21 ;
22 D NOW^%DTC
23 S HAP=%
24 ;S NODE=$$MPINODE^MPIFAPI(ENT) **711
25 S X=OLD
26 S DIC="^DPT("_ENT_",""MPIFHIS"",",DIC(0)="L"
27 I '$D(^DPT(ENT,"MPIFHIS",0)) S ^DPT(ENT,"MPIFHIS",0)="^2.0992A^0^0"
28 S DIC("P")=$P(^DPT(ENT,"MPIFHIS",0),"^",2)
29 S DA(1)=ENT
30 D ^DIC
31 ;**711 change setting of checksum and CMOR ensure correct data stored
32 S $P(^DPT(ENT,"MPIFHIS",+Y,0),"^",2)=$$CHECKDG^MPIFSPC(OLD)
33 S $P(^DPT(ENT,"MPIFHIS",+Y,0),"^",3)=$P($G(^DPT(ENT,"MPI")),"^",3)
34 S $P(^DPT(ENT,"MPIFHIS",+Y,0),"^",4)=HAP
35 ;
36 S ^DPT("AICN",OLD,ENT)=""
37 K NODE,%,HAP
38 S X=OLDX,DA=OLDDA
39 K OLDX,OLDDA
40 ;**REPLACED BY LINK MSGS MPIF*1.0*21 changes MER^MPIFMER call to quit
41 ;Send "Merge" (change) ICN message to all subscribers
42 ;N ERROR,FLG
43 ;S FLG=1
44 ;I $P($$GETICN^MPIF001(DA),"^")'="" D MER^MPIFMER(DA,X,.ERROR,FLG)
45 Q
46CMOR(OLD,RGDFN) ;ALS 6/23/00
47 ; Create CMOR History node
48 I '$D(OLD)!('$D(RGDFN)) Q
49 N NEWCMOR
50 S NEWCMOR=$$GETVCCI^MPIF001(RGDFN)
51 Q:OLD=NEWCMOR!(OLD="")
52 ;
53 D NOW^%DTC
54 S CHGDT=%
55 S NODE=$$MPINODE^MPIFAPI(RGDFN)
56 S X=OLD
57 S DIC="^DPT("_RGDFN_",""MPICMOR"",",DIC(0)="L"
58 I '$D(^DPT(RGDFN,"MPICMOR",0)) S ^DPT(RGDFN,"MPICMOR",0)="^2.0993A^0^0"
59 S DIC("P")=$P(^DPT(RGDFN,"MPICMOR",0),"^",2)
60 S DA(1)=RGDFN
61 D ^DIC
62 ; add CMOR activity score and calculation date to node
63 S $P(^DPT(RGDFN,"MPICMOR",+Y,0),"^",2)=$P(NODE,"^",6)
64 S $P(^DPT(RGDFN,"MPICMOR",+Y,0),"^",3)=$P(NODE,"^",7)
65 S $P(^DPT(RGDFN,"MPICMOR",+Y,0),"^",4)=CHGDT
66 ;
67 K NODE,%,Y,DIC,CHGDT
68 Q
69GETICNH(MDFN,ARRAY) ; **711 added API
70 ; Returns ICN History in ARRAY
71 ;Input: MDFN is the IEN in file 2
72 ;ARRAY is passed by reference and will return from ICN History nodes: ICN 'V' ICN Checksum ^ deprecated date
73 ;If there is a problem ARRAY will equal -1^error message
74 K ARRAY
75 S ARRAY=1
76 I MDFN=""!(MDFN<1) S ARRAY="-1^No such DFN" Q
77 I '$D(^DPT(MDFN)) S ARRAY="-1^No such DFN" Q
78 I '$D(^DPT(MDFN,"MPIFHIS")) S ARRAY="-1^No ICN History" Q
79 N CHK,HISTDT,HIST,CNT,VAFCHMN S HIST=0,CNT=1
80 F S HIST=$O(^DPT(MDFN,"MPIFHIS",HIST)) Q:'HIST D
81 .S VAFCHMN=$G(^DPT(MDFN,"MPIFHIS",HIST,0))
82 .S HISTDT=$P(VAFCHMN,"^",4) D
83 ..;due to a timing issue if checksum and D/T of deprication of ICN is not present hang two seconds and try again if still not able to get ICN set D/T to DT
84 ..I $G(HISTDT)="" H 2 S VAFCHMN=^DPT(MDFN,"MPIFHIS",HIST,0) S HISTDT=$P(VAFCHMN,"^",4) I HISTDT="" S $P(VAFCHMN,"^",4)=DT
85 .;verify checksum is correct, if not update it and return the updated value
86 .S CHK=$$CHECKDG^MPIFSPC($P(VAFCHMN,"^"))
87 .I CHK'=$P(VAFCHMN,"^",2) S $P(^DPT(MDFN,"MPIFHIS",HIST,0),"^",2)=CHK,$P(VAFCHMN,"^",2)=CHK
88 .S ARRAY(CNT)=$P(VAFCHMN,"^")_"V"_$P(VAFCHMN,"^",2)_"^"_HISTDT,CNT=CNT+1
89 I $O(ARRAY(0))="" S ARRAY="-1^No ICN History"
90 Q
Note: See TracBrowser for help on using the repository browser.