- VAFCHIS ;SF/CMC-TESTING CROSS REFERENCE ;11/20/97
- ;;5.3;Registration;**149,255,307,711,1015**;Aug 13, 1993;Build 21
- ;
- ; 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
- ;
- 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
- S $P(^DPT(ENT,"MPIFHIS",+Y,0),"^",2)=$$CHECKDG^MPIFSPC(OLD)
- S $P(^DPT(ENT,"MPIFHIS",+Y,0),"^",3)=$P($G(^DPT(ENT,"MPI")),"^",3)
- S $P(^DPT(ENT,"MPIFHIS",+Y,0),"^",4)=HAP
- ;
- 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
- VAFCHIS ;SF/CMC-TESTING CROSS REFERENCE ;11/20/97
- +1 ;;5.3;Registration;**149,255,307,711,1015**;Aug 13, 1993;Build 21
- +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
- +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 SET $PIECE(^DPT(ENT,"MPIFHIS",+Y,0),"^",2)=$$CHECKDG^MPIFSPC(OLD)
- +26 SET $PIECE(^DPT(ENT,"MPIFHIS",+Y,0),"^",3)=$PIECE($GET(^DPT(ENT,"MPI")),"^",3)
- +27 SET $PIECE(^DPT(ENT,"MPIFHIS",+Y,0),"^",4)=HAP
- +28 ;
- +29 SET ^DPT("AICN",OLD,ENT)=""
- +30 KILL NODE,%,HAP
- +31 SET X=OLDX
- SET DA=OLDDA
- +32 KILL OLDX,OLDDA
- +33 ;**REPLACED BY LINK MSGS MPIF*1.0*21 changes MER^MPIFMER call to quit
- +34 ;Send "Merge" (change) ICN message to all subscribers
- +35 ;N ERROR,FLG
- +36 ;S FLG=1
- +37 ;I $P($$GETICN^MPIF001(DA),"^")'="" D MER^MPIFMER(DA,X,.ERROR,FLG)
- +38 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