source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIFROMSI.m@ 1166

DIFROMSI ;SCISC/DCL-EDE IN ;3:19 PM  16 Nov 2001
 ;;22.0;VA FileMan;**94**;Mar 30, 1999
 ;Per VHA Directive 10-93-142, this routine should not be modified.
FPRE(DIFRFILE,DIFRFLG,DIFRNAME,DIFRSA) ;
 G FPRE^DIFROMSC
EPRE(DIFRFILE,DIFRIEN,DIFRFLG,DIFRNAME,DIFRSA,DIFROIEN) ;
 I '$D(DIQUIET) N DIQUIET S DIQUIET=1
 I '$D(DIFM) N DIFM S DIFM=1
 I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
 N DIOVRD S DIOVRD=1
 N DIFRRDA,DIFRX
 S DIFRFILE=$G(DIFRFILE) S:DIFRFILE'>0 DIFRFILE=$G(XPDFIL)
 I DIFRFILE'>0 D BLD^DIALOG(9521) Q
 S DIFRIEN=$G(DIFRIEN) S:DIFRIEN'>0 DIFRIEN=$G(DA)
 I DIFRIEN'>0 D BLD^DIALOG(9522) Q
 S DIFROIEN=$G(DIFROIEN) S:DIFROIEN'>0 DIFROIEN=$G(OLDA)
 I DIFROIEN'>0 D BLD^DIALOG(9523) Q
 I $G(DIFRNAME)="" D BLD^DIALOG(9524) Q
 I $G(DIFRSA)="" S DIFRSA=$NA(^XTMP("XPDI",DIFRNAME,"KRN"))
 S DIFRRDA=$$CREF^DIQGU($$ROOT^DIQGU(DIFRFILE)_DIFRIEN)
 S DIFRX=$P(@DIFRRDA@(0),"^")
 G:DIFRFILE=.84 DIALOG
 ;
 ; preserve security codes if template/form is not new
 I $G(DIFRFLG)'["N",DIFRFILE'=.5 D
 .N X,Y
 .S Y=@DIFRRDA@(0)
 .S X=@DIFRSA@(DIFRFILE,DIFROIEN,0),$P(X,U,3)=$P(Y,U,3),$P(X,U,6)=$P(Y,U,6),^(0)=X
 .Q
 ;
 I DIFRFILE'=.403 K @DIFRRDA
 E  D
 .Q:$G(DIFRFLG)["N"
 .N DA,DIC,DIK,DINUM,X,Y,DO
 .S DIK="^DIST(.403,",DA=DIFRIEN
 .D ^DIK
 .S DIC="^DIST(.403,",DIC(0)="LX",X=DIFRX,DINUM=DIFRIEN
 .D FILE^DICN
 .Q
 I DIFRFILE=.403 D
 .N DIFRA0,DIFRA1,DIFRA2,DIFRJ,DIFRL,DIFRP,DIFRX,DIFRY
 .S DIFRJ=0
 .F  S DIFRJ=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ)) Q:'DIFRJ  I $D(^(DIFRJ,0)) S DIFRP=$P(^(0),"^",2) D
 ..S:DIFRP]"" DIFRP=$O(^DIST(.404,"B",DIFRP,0))
 ..S:DIFRP $P(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,0),"^",2)=DIFRP
 ..S DIFRL=0
 ..F  S DIFRL=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,DIFRL)) Q:'DIFRL  S DIFRA0=$G(^(DIFRL,0)),DIFRP=$P(DIFRA0,"^") I DIFRP]"" D
 ...S DIFRP=$O(^DIST(.404,"B",DIFRP,0)) I DIFRP D
 ....S $P(DIFRA0,"^")=DIFRP,@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK",DIFRP,0)=DIFRA0
 ....N DIFRX
 ....S DIFRX=0
 ....F  S DIFRX=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,DIFRL,DIFRX)) Q:DIFRX=""  S @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK",DIFRP,DIFRX)=^(DIFRX)
 ....Q
 ...Q
 ..S DIFRA0=$G(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,0))
 ..Q:DIFRA0=""
 ..K @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40)
 ..S (DIFRA1,DIFRA2)=0
 ..S DIFRL=0
 ..F  S DIFRL=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK",DIFRL)) Q:'DIFRL  S @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,DIFRL,0)=^(DIFRL,0),DIFRA1=DIFRL,DIFRA2=DIFRA2+1 D
 ...N DIFRX
 ...S DIFRX=0
 ...F  S DIFRX=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK",DIFRL,DIFRX)) Q:DIFRX=""  S @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,DIFRL,DIFRX)=^(DIFRX)
 ...Q
 ..S $P(DIFRA0,"^",3,4)=DIFRA1_"^"_DIFRA2
 ..S @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,0)=DIFRA0
 ..K @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK")
 ..Q
 .Q
 Q
DIALOG N DIFRF,DIFRX
 S DIFRF=$P(@DIFRSA@(DIFRFILE,DIFROIEN,0),"^",4)
 I DIFRF]"" D
 .S DIFRF=$O(^DIC(9.4,"B",DIFRF,0)) I DIFRF,$O(^(DIFRF)) D  S DIFRF=""
 ..N DIFRERR S DIFRERR(1)=DIFRF,DIFRERR(2)=DIFRIEN
 ..D BLD^DIALOG(9525,.DIFRERR)
 ..Q
 .S $P(@DIFRSA@(DIFRFILE,DIFROIEN,0),"^",4)=DIFRF
 F DIFRX=1,2,3,5,6 K @DIFRRDA@(DIFRX)
 Q
EPOST(DIFRFILE,DIFRIEN,DIFRFLG,DIFRNAME,DIFRSA) ;
 I '$D(DIQUIET) N DIQUIET S DIQUIET=1
 I '$D(DIFM) N DIFM S DIFM=1
 I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
 N DIOVRD S DIOVRD=1
 I '$G(DIFRFILE)!('$G(DIFRIEN)) Q
 I $G(DIFRNAME)="" Q
 S:$G(DIFRSA)']"" DIFRSA=$NA(^XTMP("XPDI",DIFRNAME))
 N DA,DIFR,DIFR3,DIFROU,DIK,DMAX,DNM,X,Y,Z,DIFRTN
 S DIK=$$ROOT^DILFD(DIFRFILE),DA=DIFRIEN
 D IX1^DIK
 I DIFRFILE=.403,DIFRIEN D ENGRP^DDSZ(DIFRIEN) Q
 S DIFR=$S(DIFRFILE=.4:"DIPT",DIFRFILE=.402:"DIE",1:"")
 Q:DIFR=""
 I ^DD("VERSION")>17.4,'$D(DISYS) D OS^DII
 E  S DISYS=^DD("OS")
 I '$D(^DD("OS",DISYS,"ZS")) D BLD^DIALOG(9526) Q
 S Y=DIFRIEN
 I $D(@("^"_DIFR_"(Y,""ROU"")")) K ^("ROU") I $D(^("ROUOLD")) S (DIFROU,X)=^("ROUOLD"),DIFRTN=$P(^(0),"^") D:X]""
 .N %X,DIR,DMAX,X,Y,DIFRZTA
 .S DIFR3="DI"_$E(DIFR,3)_"Z"
 .I $$VAL^DIFROMSS(DIFRFILE,DIFRIEN) D  Q
 ..D @("EN2^"_DIFR3_"(DIFRIEN,"""",DIFROU,"""",""DIFRZTA"")")
 ..I $D(DIFRZTA) M @DIFRSA@(DIFR3,DIFRIEN)=DIFRZTA
 ..S @DIFRSA@(DIFR3,DIFRIEN)=DIFROU
 ..Q
 .N DIFRTT,DIFRERR S DIFRTT=$S(DIFRFILE=.4:"PRINT",1:"INPUT")
 .S DIFRERR(1)=DIFRTT,DIFRERR(2)=DIFRTN
 .D BLD^DIALOG(9528,.DIFRERR)
 .Q
 Q
FPOST ;
 G FPOST^DIFROMSC
EXIT I $G(DIFRMSGR)]"" D CALLOUT^DIEFU(DIFRMSGR)
 Q