VAFCHIS ;SF/CMC-TESTING CROSS REFERENCE ;11/20/97
;;5.3;Registration;**149,255,307,711,902**;Aug 13, 1993;Build 2
;
; Integration Agreements Utilized:
; CHECKDG^MPIFSPC - #3158
;
ICN(OLD,ENT) ;
;
I '$D(OLD)!('$D(ENT)) Q
N NEWICN,DIC,Y
;checking that CIRN PD/MPI is installed
N X S X="MPIF001" X ^%ZOSF("TEST") Q:'$T
N X S X="MPIFAPI" X ^%ZOSF("TEST") Q:'$T
N X S X="MPIFMER" X ^%ZOSF("TEST") Q:'$T
S NEWICN=+$$GETICN^MPIF001(ENT)
Q:OLD=NEWICN!(OLD="")
; ^ UPDATE ICN WITH SAME ICN DON'T PUT IT IN HISTORY
;
S OLDDA=DA,OLDX=OLD
N DA,CKOLD
;
D NOW^%DTC
S HAP=%
;S NODE=$$MPINODE^MPIFAPI(ENT) **711
S X=OLD
S DIC="^DPT("_ENT_",""MPIFHIS"",",DIC(0)="L"
I '$D(^DPT(ENT,"MPIFHIS",0)) S ^DPT(ENT,"MPIFHIS",0)="^2.0992A^0^0"
S DIC("P")=$P(^DPT(ENT,"MPIFHIS",0),"^",2)
S DA(1)=ENT
D ^DIC
;**711 change setting of checksum and CMOR ensure correct data stored
;**902 save correct old checksum to store in FULL ICN history also
;S $P(^DPT(ENT,"MPIFHIS",+Y,0),"^",2)=$$CHECKDG^MPIFSPC(OLD)
S CKOLD=$$CHECKDG^MPIFSPC(OLD)
S $P(^DPT(ENT,"MPIFHIS",+Y,0),"^",2)=CKOLD
S $P(^DPT(ENT,"MPIFHIS",+Y,0),"^",3)=$P($G(^DPT(ENT,"MPI")),"^",3)
S $P(^DPT(ENT,"MPIFHIS",+Y,0),"^",4)=HAP
;
;**902 set FULL ICN history
K DA,DIC
S X=OLD_"V"_CKOLD
S DIC="^DPT("_ENT_",""MPIFICNHIS"",",DIC(0)="L"
S DA(1)=ENT
D ^DIC
;
S ^DPT("AICN",OLD,ENT)=""
K NODE,%,HAP
S X=OLDX,DA=OLDDA
K OLDX,OLDDA
;**REPLACED BY LINK MSGS MPIF*1.0*21 changes MER^MPIFMER call to quit
;Send "Merge" (change) ICN message to all subscribers
;N ERROR,FLG
;S FLG=1
;I $P($$GETICN^MPIF001(DA),"^")'="" D MER^MPIFMER(DA,X,.ERROR,FLG)
Q
CMOR(OLD,RGDFN) ;ALS 6/23/00
; Create CMOR History node
I '$D(OLD)!('$D(RGDFN)) Q
N NEWCMOR
S NEWCMOR=$$GETVCCI^MPIF001(RGDFN)
Q:OLD=NEWCMOR!(OLD="")
;
D NOW^%DTC
S CHGDT=%
S NODE=$$MPINODE^MPIFAPI(RGDFN)
S X=OLD
S DIC="^DPT("_RGDFN_",""MPICMOR"",",DIC(0)="L"
I '$D(^DPT(RGDFN,"MPICMOR",0)) S ^DPT(RGDFN,"MPICMOR",0)="^2.0993A^0^0"
S DIC("P")=$P(^DPT(RGDFN,"MPICMOR",0),"^",2)
S DA(1)=RGDFN
D ^DIC
; add CMOR activity score and calculation date to node
S $P(^DPT(RGDFN,"MPICMOR",+Y,0),"^",2)=$P(NODE,"^",6)
S $P(^DPT(RGDFN,"MPICMOR",+Y,0),"^",3)=$P(NODE,"^",7)
S $P(^DPT(RGDFN,"MPICMOR",+Y,0),"^",4)=CHGDT
;
K NODE,%,Y,DIC,CHGDT
Q
GETICNH(MDFN,ARRAY) ; **711 added API
; Returns ICN History in ARRAY
;Input: MDFN is the IEN in file 2
;ARRAY is passed by reference and will return from ICN History nodes: ICN 'V' ICN Checksum ^ deprecated date
;If there is a problem ARRAY will equal -1^error message
K ARRAY
S ARRAY=1
I MDFN=""!(MDFN<1) S ARRAY="-1^No such DFN" Q
I '$D(^DPT(MDFN)) S ARRAY="-1^No such DFN" Q
I '$D(^DPT(MDFN,"MPIFHIS")) S ARRAY="-1^No ICN History" Q
N CHK,HISTDT,HIST,CNT,VAFCHMN S HIST=0,CNT=1
F S HIST=$O(^DPT(MDFN,"MPIFHIS",HIST)) Q:'HIST D
.S VAFCHMN=$G(^DPT(MDFN,"MPIFHIS",HIST,0))
.S HISTDT=$P(VAFCHMN,"^",4) D
..;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
..I $G(HISTDT)="" H 2 S VAFCHMN=^DPT(MDFN,"MPIFHIS",HIST,0) S HISTDT=$P(VAFCHMN,"^",4) I HISTDT="" S $P(VAFCHMN,"^",4)=DT
.;verify checksum is correct, if not update it and return the updated value
.S CHK=$$CHECKDG^MPIFSPC($P(VAFCHMN,"^"))
.I CHK'=$P(VAFCHMN,"^",2) S $P(^DPT(MDFN,"MPIFHIS",HIST,0),"^",2)=CHK,$P(VAFCHMN,"^",2)=CHK
.S ARRAY(CNT)=$P(VAFCHMN,"^")_"V"_$P(VAFCHMN,"^",2)_"^"_HISTDT,CNT=CNT+1
I $O(ARRAY(0))="" S ARRAY="-1^No ICN History"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCHIS 3616 printed Nov 22, 2024@18:11:43 Page 2
VAFCHIS ;SF/CMC-TESTING CROSS REFERENCE ;11/20/97
+1 ;;5.3;Registration;**149,255,307,711,902**;Aug 13, 1993;Build 2
+2 ;
+3 ; Integration Agreements Utilized:
+4 ; CHECKDG^MPIFSPC - #3158
+5 ;
ICN(OLD,ENT) ;
+1 ;
+2 IF '$DATA(OLD)!('$DATA(ENT))
QUIT
+3 NEW NEWICN,DIC,Y
+4 ;checking that CIRN PD/MPI is installed
+5 NEW X
SET X="MPIF001"
XECUTE ^%ZOSF("TEST")
if '$TEST
QUIT
+6 NEW X
SET X="MPIFAPI"
XECUTE ^%ZOSF("TEST")
if '$TEST
QUIT
+7 NEW X
SET X="MPIFMER"
XECUTE ^%ZOSF("TEST")
if '$TEST
QUIT
+8 SET NEWICN=+$$GETICN^MPIF001(ENT)
+9 if OLD=NEWICN!(OLD="")
QUIT
+10 ; ^ UPDATE ICN WITH SAME ICN DON'T PUT IT IN HISTORY
+11 ;
+12 SET OLDDA=DA
SET OLDX=OLD
+13 NEW DA,CKOLD
+14 ;
+15 DO NOW^%DTC
+16 SET HAP=%
+17 ;S NODE=$$MPINODE^MPIFAPI(ENT) **711
+18 SET X=OLD
+19 SET DIC="^DPT("_ENT_",""MPIFHIS"","
SET DIC(0)="L"
+20 IF '$DATA(^DPT(ENT,"MPIFHIS",0))
SET ^DPT(ENT,"MPIFHIS",0)="^2.0992A^0^0"
+21 SET DIC("P")=$PIECE(^DPT(ENT,"MPIFHIS",0),"^",2)
+22 SET DA(1)=ENT
+23 DO ^DIC
+24 ;**711 change setting of checksum and CMOR ensure correct data stored
+25 ;**902 save correct old checksum to store in FULL ICN history also
+26 ;S $P(^DPT(ENT,"MPIFHIS",+Y,0),"^",2)=$$CHECKDG^MPIFSPC(OLD)
+27 SET CKOLD=$$CHECKDG^MPIFSPC(OLD)
+28 SET $PIECE(^DPT(ENT,"MPIFHIS",+Y,0),"^",2)=CKOLD
+29 SET $PIECE(^DPT(ENT,"MPIFHIS",+Y,0),"^",3)=$PIECE($GET(^DPT(ENT,"MPI")),"^",3)
+30 SET $PIECE(^DPT(ENT,"MPIFHIS",+Y,0),"^",4)=HAP
+31 ;
+32 ;**902 set FULL ICN history
+33 KILL DA,DIC
+34 SET X=OLD_"V"_CKOLD
+35 SET DIC="^DPT("_ENT_",""MPIFICNHIS"","
SET DIC(0)="L"
+36 SET DA(1)=ENT
+37 DO ^DIC
+38 ;
+39 SET ^DPT("AICN",OLD,ENT)=""
+40 KILL NODE,%,HAP
+41 SET X=OLDX
SET DA=OLDDA
+42 KILL OLDX,OLDDA
+43 ;**REPLACED BY LINK MSGS MPIF*1.0*21 changes MER^MPIFMER call to quit
+44 ;Send "Merge" (change) ICN message to all subscribers
+45 ;N ERROR,FLG
+46 ;S FLG=1
+47 ;I $P($$GETICN^MPIF001(DA),"^")'="" D MER^MPIFMER(DA,X,.ERROR,FLG)
+48 QUIT
CMOR(OLD,RGDFN) ;ALS 6/23/00
+1 ; Create CMOR History node
+2 IF '$DATA(OLD)!('$DATA(RGDFN))
QUIT
+3 NEW NEWCMOR
+4 SET NEWCMOR=$$GETVCCI^MPIF001(RGDFN)
+5 if OLD=NEWCMOR!(OLD="")
QUIT
+6 ;
+7 DO NOW^%DTC
+8 SET CHGDT=%
+9 SET NODE=$$MPINODE^MPIFAPI(RGDFN)
+10 SET X=OLD
+11 SET DIC="^DPT("_RGDFN_",""MPICMOR"","
SET DIC(0)="L"
+12 IF '$DATA(^DPT(RGDFN,"MPICMOR",0))
SET ^DPT(RGDFN,"MPICMOR",0)="^2.0993A^0^0"
+13 SET DIC("P")=$PIECE(^DPT(RGDFN,"MPICMOR",0),"^",2)
+14 SET DA(1)=RGDFN
+15 DO ^DIC
+16 ; add CMOR activity score and calculation date to node
+17 SET $PIECE(^DPT(RGDFN,"MPICMOR",+Y,0),"^",2)=$PIECE(NODE,"^",6)
+18 SET $PIECE(^DPT(RGDFN,"MPICMOR",+Y,0),"^",3)=$PIECE(NODE,"^",7)
+19 SET $PIECE(^DPT(RGDFN,"MPICMOR",+Y,0),"^",4)=CHGDT
+20 ;
+21 KILL NODE,%,Y,DIC,CHGDT
+22 QUIT
GETICNH(MDFN,ARRAY) ; **711 added API
+1 ; Returns ICN History in ARRAY
+2 ;Input: MDFN is the IEN in file 2
+3 ;ARRAY is passed by reference and will return from ICN History nodes: ICN 'V' ICN Checksum ^ deprecated date
+4 ;If there is a problem ARRAY will equal -1^error message
+5 KILL ARRAY
+6 SET ARRAY=1
+7 IF MDFN=""!(MDFN<1)
SET ARRAY="-1^No such DFN"
QUIT
+8 IF '$DATA(^DPT(MDFN))
SET ARRAY="-1^No such DFN"
QUIT
+9 IF '$DATA(^DPT(MDFN,"MPIFHIS"))
SET ARRAY="-1^No ICN History"
QUIT
+10 NEW CHK,HISTDT,HIST,CNT,VAFCHMN
SET HIST=0
SET CNT=1
+11 FOR
SET HIST=$ORDER(^DPT(MDFN,"MPIFHIS",HIST))
if 'HIST
QUIT
Begin DoDot:1
+12 SET VAFCHMN=$GET(^DPT(MDFN,"MPIFHIS",HIST,0))
+13 SET HISTDT=$PIECE(VAFCHMN,"^",4)
Begin DoDot:2
+14 ;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
+15 IF $GET(HISTDT)=""
HANG 2
SET VAFCHMN=^DPT(MDFN,"MPIFHIS",HIST,0)
SET HISTDT=$PIECE(VAFCHMN,"^",4)
IF HISTDT=""
SET $PIECE(VAFCHMN,"^",4)=DT
End DoDot:2
+16 ;verify checksum is correct, if not update it and return the updated value
+17 SET CHK=$$CHECKDG^MPIFSPC($PIECE(VAFCHMN,"^"))
+18 IF CHK'=$PIECE(VAFCHMN,"^",2)
SET $PIECE(^DPT(MDFN,"MPIFHIS",HIST,0),"^",2)=CHK
SET $PIECE(VAFCHMN,"^",2)=CHK
+19 SET ARRAY(CNT)=$PIECE(VAFCHMN,"^")_"V"_$PIECE(VAFCHMN,"^",2)_"^"_HISTDT
SET CNT=CNT+1
End DoDot:1
+20 IF $ORDER(ARRAY(0))=""
SET ARRAY="-1^No ICN History"
+21 QUIT
