Return to DIFROMSI.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFROMSI.m, revision 1.1.1.1

1.1       snw         1: DIFROMSI       ;SCISC/DCL-EDE IN ;08:42 AM  22 Nov 1994;
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
                      4: FPRE(DIFRFILE,DIFRFLG,DIFRNAME,DIFRSA) ;
                      5:        G FPRE^DIFROMSC
                      6: EPRE(DIFRFILE,DIFRIEN,DIFRFLG,DIFRNAME,DIFRSA,DIFROIEN)        ;
                      7:        I '$D(DIQUIET) N DIQUIET S DIQUIET=1
                      8:        I '$D(DIFM) N DIFM S DIFM=1
                      9:        I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
                     10:        N DIOVRD S DIOVRD=1
                     11:        N DIFRRDA,DIFRX
                     12:        S DIFRFILE=$G(DIFRFILE) S:DIFRFILE'>0 DIFRFILE=$G(XPDFIL)
                     13:        I DIFRFILE'>0 D BLD^DIALOG(9521) Q
                     14:        S DIFRIEN=$G(DIFRIEN) S:DIFRIEN'>0 DIFRIEN=$G(DA)
                     15:        I DIFRIEN'>0 D BLD^DIALOG(9522) Q
                     16:        S DIFROIEN=$G(DIFROIEN) S:DIFROIEN'>0 DIFROIEN=$G(OLDA)
                     17:        I DIFROIEN'>0 D BLD^DIALOG(9523) Q
                     18:        I $G(DIFRNAME)="" D BLD^DIALOG(9524) Q
                     19:        I $G(DIFRSA)="" S DIFRSA=$NA(^XTMP("XPDI",DIFRNAME,"KRN"))
                     20:        S DIFRRDA=$$CREF^DIQGU($$ROOT^DIQGU(DIFRFILE)_DIFRIEN)
                     21:        S DIFRX=$P(@DIFRRDA@(0),"^")
                     22:        G:DIFRFILE=.84 DIALOG
                     23:        I DIFRFILE'=.403 K @DIFRRDA
                     24:        E  D
                     25:        .Q:$G(DIFRFLG)["N"
                     26:        .N DA,DIC,DIK,DINUM,X,Y
                     27:        .S DIK="^DIST(.403,",DA=DIFRIEN
                     28:        .D ^DIK
                     29:        .S DIC="^DIST(.403,",DIC(0)="LX",X=DIFRX,DINUM=DIFRIEN
                     30:        .D FILE^DICN
                     31:        .Q
                     32:        I DIFRFILE=.403 D
                     33:        .N DIFRA0,DIFRA1,DIFRA2,DIFRJ,DIFRL,DIFRP,DIFRX,DIFRY
                     34:        .S DIFRJ=0
                     35:        .F  S DIFRJ=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ)) Q:'DIFRJ  I $D(^(DIFRJ,0)) S DIFRP=$P(^(0),"^",2) D
                     36:        ..S:DIFRP]"" DIFRP=$O(^DIST(.404,"B",DIFRP,0))
                     37:        ..S:DIFRP $P(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,0),"^",2)=DIFRP
                     38:        ..S DIFRL=0
                     39:        ..F  S DIFRL=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,DIFRL)) Q:'DIFRL  S DIFRA0=$G(^(DIFRL,0)),DIFRP=$P(DIFRA0,"^") I DIFRP]"" D
                     40:        ...S DIFRP=$O(^DIST(.404,"B",DIFRP,0)) I DIFRP D
                     41:        ....S $P(DIFRA0,"^")=DIFRP,@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK",DIFRP,0)=DIFRA0
                     42:        ....N DIFRX
                     43:        ....S DIFRX=0
                     44:        ....F  S DIFRX=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,DIFRL,DIFRX)) Q:DIFRX=""  S @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK",DIFRP,DIFRX)=^(DIFRX)
                     45:        ....Q
                     46:        ...Q
                     47:        ..S DIFRA0=$G(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,0))
                     48:        ..Q:DIFRA0=""
                     49:        ..K @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40)
                     50:        ..S (DIFRA1,DIFRA2)=0
                     51:        ..S DIFRL=0
                     52:        ..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
                     53:        ...N DIFRX
                     54:        ...S DIFRX=0
                     55:        ...F  S DIFRX=$O(@DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK",DIFRL,DIFRX)) Q:DIFRX=""  S @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,DIFRL,DIFRX)=^(DIFRX)
                     56:        ...Q
                     57:        ..S $P(DIFRA0,"^",3,4)=DIFRA1_"^"_DIFRA2
                     58:        ..S @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,40,0)=DIFRA0
                     59:        ..K @DIFRSA@(DIFRFILE,DIFROIEN,40,DIFRJ,"BLK")
                     60:        ..Q
                     61:        .Q
                     62:        Q
                     63: DIALOG N DIFRF,DIFRX
                     64:        S DIFRF=$P(@DIFRSA@(DIFRFILE,DIFROIEN,0),"^",4)
                     65:        I DIFRF]"" D
                     66:        .S DIFRF=$O(^DIC(9.4,"B",DIFRF,0)) I DIFRF,$O(^(DIFRF)) D  S DIFRF=""
                     67:        ..N DIFRERR S DIFRERR(1)=DIFRF,DIFRERR(2)=DIFRIEN
                     68:        ..D BLD^DIALOG(9525,.DIFRERR)
                     69:        ..Q
                     70:        .S $P(@DIFRSA@(DIFRFILE,DIFROIEN,0),"^",4)=DIFRF
                     71:        F DIFRX=1,2,3,5,6 K @DIFRRDA@(DIFRX)
                     72:        Q
                     73: EPOST(DIFRFILE,DIFRIEN,DIFRFLG,DIFRNAME,DIFRSA)        ;
                     74:        I '$D(DIQUIET) N DIQUIET S DIQUIET=1
                     75:        I '$D(DIFM) N DIFM S DIFM=1
                     76:        I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
                     77:        N DIOVRD S DIOVRD=1
                     78:        I '$G(DIFRFILE)!('$G(DIFRIEN)) Q
                     79:        I $G(DIFRNAME)="" Q
                     80:        S:$G(DIFRSA)']"" DIFRSA=$NA(^XTMP("XPDI",DIFRNAME))
                     81:        N DA,DIFR,DIFR3,DIFROU,DIK,DMAX,DNM,X,Y,Z,DIFRTN
                     82:        S DIK=$$ROOT^DILFD(DIFRFILE),DA=DIFRIEN
                     83:        D IX1^DIK
                     84:        I DIFRFILE=.403,DIFRIEN D  Q
                     85:        .I $$VAL^DIFROMSS(DIFRFILE,DIFRIEN) D EN^DDSZ(DIFRIEN) Q
                     86:        .S DIFRTN=$P($G(^DIST(.403,DIFRIEN,0)),"^")
                     87:        .N DIFRERR S DIFRERR(1)=DIFRTN
                     88:        .D BLD^DIALOG(9527,.DIFRERR)
                     89:        .Q
                     90:        S DIFR=$S(DIFRFILE=.4:"DIPT",DIFRFILE=.402:"DIE",1:"")
                     91:        Q:DIFR=""
                     92:        I ^DD("VERSION")>17.4,'$D(DISYS) D OS^DII
                     93:        E  S DISYS=^DD("OS")
                     94:        I '$D(^DD("OS",DISYS,"ZS")) D BLD^DIALOG(9526) Q
                     95:        S Y=DIFRIEN
                     96:        I $D(@("^"_DIFR_"(Y,""ROU"")")) K ^("ROU") I $D(^("ROUOLD")) S (DIFROU,X)=^("ROUOLD"),DIFRTN=$P(^(0),"^") D:X]""
                     97:        .N %X,DIR,DMAX,X,Y,DIFRZTA
                     98:        .S DIFR3="DI"_$E(DIFR,3)_"Z"
                     99:        .I $$VAL^DIFROMSS(DIFRFILE,DIFRIEN) D  Q
                    100:        ..D @("EN2^"_DIFR3_"(DIFRIEN,"""",DIFROU,"""",""DIFRZTA"")")
                    101:        ..I $D(DIFRZTA) M @DIFRSA@(DIFR3,DIFRIEN)=DIFRZTA
                    102:        ..S @DIFRSA@(DIFR3,DIFRIEN)=DIFROU
                    103:        ..Q
                    104:        .N DIFRTT,DIFRERR S DIFRTT=$S(DIFRFILE=.4:"PRINT",1:"INPUT")
                    105:        .S DIFRERR(1)=DIFRTT,DIFRERR(2)=DIFRTN
                    106:        .D BLD^DIALOG(9528,.DIFRERR)
                    107:        .Q
                    108:        Q
                    109: FPOST  ;
                    110:        G FPOST^DIFROMSC
                    111: EXIT   I $G(DIFRMSGR)]"" D CALLOUT^DIEFU(DIFRMSGR)
                    112:        Q