Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFCHIS

VAFCHIS.m

Go to the documentation of this file.
  1. VAFCHIS ;SF/CMC-TESTING CROSS REFERENCE ;11/20/97
  1. ;;5.3;Registration;**149,255,307,711,1015**;Aug 13, 1993;Build 21
  1. ;
  1. ; Integration Agreements Utilized:
  1. ; CHECKDG^MPIFSPC - #3158
  1. ;
  1. ICN(OLD,ENT) ;
  1. ;
  1. I '$D(OLD)!('$D(ENT)) Q
  1. N NEWICN,DIC,Y
  1. ;checking that CIRN PD/MPI is installed
  1. N X S X="MPIF001" X ^%ZOSF("TEST") Q:'$T
  1. N X S X="MPIFAPI" X ^%ZOSF("TEST") Q:'$T
  1. N X S X="MPIFMER" X ^%ZOSF("TEST") Q:'$T
  1. S NEWICN=+$$GETICN^MPIF001(ENT)
  1. Q:OLD=NEWICN!(OLD="")
  1. ; ^ UPDATE ICN WITH SAME ICN DON'T PUT IT IN HISTORY
  1. ;
  1. S OLDDA=DA,OLDX=OLD
  1. N DA
  1. ;
  1. D NOW^%DTC
  1. S HAP=%
  1. ;S NODE=$$MPINODE^MPIFAPI(ENT) **711
  1. S X=OLD
  1. S DIC="^DPT("_ENT_",""MPIFHIS"",",DIC(0)="L"
  1. I '$D(^DPT(ENT,"MPIFHIS",0)) S ^DPT(ENT,"MPIFHIS",0)="^2.0992A^0^0"
  1. S DIC("P")=$P(^DPT(ENT,"MPIFHIS",0),"^",2)
  1. S DA(1)=ENT
  1. D ^DIC
  1. ;**711 change setting of checksum and CMOR ensure correct data stored
  1. S $P(^DPT(ENT,"MPIFHIS",+Y,0),"^",2)=$$CHECKDG^MPIFSPC(OLD)
  1. S $P(^DPT(ENT,"MPIFHIS",+Y,0),"^",3)=$P($G(^DPT(ENT,"MPI")),"^",3)
  1. S $P(^DPT(ENT,"MPIFHIS",+Y,0),"^",4)=HAP
  1. ;
  1. S ^DPT("AICN",OLD,ENT)=""
  1. K NODE,%,HAP
  1. S X=OLDX,DA=OLDDA
  1. K OLDX,OLDDA
  1. ;**REPLACED BY LINK MSGS MPIF*1.0*21 changes MER^MPIFMER call to quit
  1. ;Send "Merge" (change) ICN message to all subscribers
  1. ;N ERROR,FLG
  1. ;S FLG=1
  1. ;I $P($$GETICN^MPIF001(DA),"^")'="" D MER^MPIFMER(DA,X,.ERROR,FLG)
  1. Q
  1. CMOR(OLD,RGDFN) ;ALS 6/23/00
  1. ; Create CMOR History node
  1. I '$D(OLD)!('$D(RGDFN)) Q
  1. N NEWCMOR
  1. S NEWCMOR=$$GETVCCI^MPIF001(RGDFN)
  1. Q:OLD=NEWCMOR!(OLD="")
  1. ;
  1. D NOW^%DTC
  1. S CHGDT=%
  1. S NODE=$$MPINODE^MPIFAPI(RGDFN)
  1. S X=OLD
  1. S DIC="^DPT("_RGDFN_",""MPICMOR"",",DIC(0)="L"
  1. I '$D(^DPT(RGDFN,"MPICMOR",0)) S ^DPT(RGDFN,"MPICMOR",0)="^2.0993A^0^0"
  1. S DIC("P")=$P(^DPT(RGDFN,"MPICMOR",0),"^",2)
  1. S DA(1)=RGDFN
  1. D ^DIC
  1. ; add CMOR activity score and calculation date to node
  1. S $P(^DPT(RGDFN,"MPICMOR",+Y,0),"^",2)=$P(NODE,"^",6)
  1. S $P(^DPT(RGDFN,"MPICMOR",+Y,0),"^",3)=$P(NODE,"^",7)
  1. S $P(^DPT(RGDFN,"MPICMOR",+Y,0),"^",4)=CHGDT
  1. ;
  1. K NODE,%,Y,DIC,CHGDT
  1. Q
  1. GETICNH(MDFN,ARRAY) ; **711 added API
  1. ; Returns ICN History in ARRAY
  1. ;Input: MDFN is the IEN in file 2
  1. ;ARRAY is passed by reference and will return from ICN History nodes: ICN 'V' ICN Checksum ^ deprecated date
  1. ;If there is a problem ARRAY will equal -1^error message
  1. K ARRAY
  1. S ARRAY=1
  1. I MDFN=""!(MDFN<1) S ARRAY="-1^No such DFN" Q
  1. I '$D(^DPT(MDFN)) S ARRAY="-1^No such DFN" Q
  1. I '$D(^DPT(MDFN,"MPIFHIS")) S ARRAY="-1^No ICN History" Q
  1. N CHK,HISTDT,HIST,CNT,VAFCHMN S HIST=0,CNT=1
  1. F S HIST=$O(^DPT(MDFN,"MPIFHIS",HIST)) Q:'HIST D
  1. .S VAFCHMN=$G(^DPT(MDFN,"MPIFHIS",HIST,0))
  1. .S HISTDT=$P(VAFCHMN,"^",4) D
  1. ..;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
  1. ..I $G(HISTDT)="" H 2 S VAFCHMN=^DPT(MDFN,"MPIFHIS",HIST,0) S HISTDT=$P(VAFCHMN,"^",4) I HISTDT="" S $P(VAFCHMN,"^",4)=DT
  1. .;verify checksum is correct, if not update it and return the updated value
  1. .S CHK=$$CHECKDG^MPIFSPC($P(VAFCHMN,"^"))
  1. .I CHK'=$P(VAFCHMN,"^",2) S $P(^DPT(MDFN,"MPIFHIS",HIST,0),"^",2)=CHK,$P(VAFCHMN,"^",2)=CHK
  1. .S ARRAY(CNT)=$P(VAFCHMN,"^")_"V"_$P(VAFCHMN,"^",2)_"^"_HISTDT,CNT=CNT+1
  1. I $O(ARRAY(0))="" S ARRAY="-1^No ICN History"
  1. Q