- DIAXM1 ;SFISC/DCM-PROCESS MAPPING INFORMATION (CONT) ;7/11/95 06:33
- ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- ;;Per VA Directive 6402, this routine should not be modified.
- ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- ;;Licensed under the terms of the Apache License, Version 2.0.
- ;
- EN D @DIAXFTY Q:DIAXFR Q:$D(DIAXMSG)
- I DIAXFR("TYP")'=DIAXTO("TYP"),'$D(DIAXEXT) S DIAXEXT=1
- D:'$D(DIAR) DJ
- Q
- ;
- F Q:DIAXFR!($D(DIAXMSG)) I DIAXFR("TY")["C" D CF^DIAXM2 Q
- I "FSP"[DIAXFR("TYP"),+DIAXFR("LO"),DIAXFR("LO")<DIAXTO("LO") S DIAXE2=DIAXFR("LO") D E1,E3
- I "FSP"[DIAXFR("TYP"),DIAXFR("HI")>DIAXTO("HI") S DIAXE2=DIAXFR("HI") D E2
- I DIAXFR("TY")["N",DIAXFR("LE")<DIAXTO("LO") S DIAXE2=DIAXFR("LE") D E1,E3
- I DIAXFR("TY")["N",DIAXFR("LE")>DIAXTO("HI") S DIAXE2=DIAXFR("LE") D E2
- I DIAXFR("TY")["D",DIAXTO("LO")>14 S DIAXE2=14 D E1,E3
- I DIAXFR("TY")["D",DIAXTO("HI")<14 S DIAXE2=14 D E2
- Q
- ;
- N G N^DIAXM3
- ;
- D G D^DIAXM3
- ;
- P D XT I DIAXEXT D P^DIAXM2 Q:$D(DIAXMSG)!DIAXFR
- D HL^DIAXM(15,1)
- Q
- ;
- V D XT I DIAXEXT D V^DIAXM2 Q:$D(DIAXMSG)!DIAXFR
- D HL^DIAXM(30,3)
- Q
- ;
- C G C^DIAXM2
- ;
- S I DIAXTO W:'$D(DIAR) !?DIAXTAB,$C(7),"Make sure the SET OF CODES are identical as the extract field." Q
- D XT D S^DIAXM2
- Q
- ;
- W Q:DIAXFR
- I DIAXFR("TY")["L",DIAXTO("TY")'["L" D E3 S DIAXEM=DIAXEM_"be in 'L'ine mode." D X
- Q
- ;
- K Q
- ;
- E1 S DIAXE1="minimum" Q
- E2 S DIAXE1="maximum"
- E3 S DIAXEM=DIAXTO("NM")_" field in "_DIAXEF_$S($D(DIAXSB):" subfile",1:" file")_" should " Q:DIAXFTY["W"
- S DIAXEM=DIAXEM_"have a "_DIAXE1_" length of at least "_DIAXE2_" characters."
- X D ERR^DIAXERR(DIAXEM)
- K DIAXE1,DIAXE2
- Q
- ;
- DJ S DIAXDJ=DIAXDJ+1
- S ^UTILITY("DIFG",$J,DIAXC,DIAXDJ)=DIAXS_U_U_+Y_U_$P(Y(0),U,4)_U_$G(DIAXEXT)
- S S=DIAXS,DJ=DIAXDJ,C=DIAXC
- Q
- ;
- XT S DIAXEXT=+$G(DIAXEXT) I '$D(DIAR),$D(DC(DC)) S DIAXEXT=+$P(DC(DC),U,5) Q:'DINS
- Q:$D(DIAR)
- K DIR N Y S DIR(0)="Y",DIR("A")="Move EXTERNAL form of the data to the extract field",DIR("B")="Yes",DIR("?")="Answer YES if the RESOLVED value of data should be moved"
- D ^DIR K DIR Q:'Y
- S DIAXEXT=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIAXM1 2189 printed Feb 19, 2025@00:11:20 Page 2
- DIAXM1 ;SFISC/DCM-PROCESS MAPPING INFORMATION (CONT) ;7/11/95 06:33
- +1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- +4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- +5 ;;Licensed under the terms of the Apache License, Version 2.0.
- +6 ;
- EN DO @DIAXFTY
- if DIAXFR
- QUIT
- if $DATA(DIAXMSG)
- QUIT
- +1 IF DIAXFR("TYP")'=DIAXTO("TYP")
- IF '$DATA(DIAXEXT)
- SET DIAXEXT=1
- +2 if '$DATA(DIAR)
- DO DJ
- +3 QUIT
- +4 ;
- F if DIAXFR!($DATA(DIAXMSG))
- QUIT
- IF DIAXFR("TY")["C"
- DO CF^DIAXM2
- QUIT
- +1 IF "FSP"[DIAXFR("TYP")
- IF +DIAXFR("LO")
- IF DIAXFR("LO")<DIAXTO("LO")
- SET DIAXE2=DIAXFR("LO")
- DO E1
- DO E3
- +2 IF "FSP"[DIAXFR("TYP")
- IF DIAXFR("HI")>DIAXTO("HI")
- SET DIAXE2=DIAXFR("HI")
- DO E2
- +3 IF DIAXFR("TY")["N"
- IF DIAXFR("LE")<DIAXTO("LO")
- SET DIAXE2=DIAXFR("LE")
- DO E1
- DO E3
- +4 IF DIAXFR("TY")["N"
- IF DIAXFR("LE")>DIAXTO("HI")
- SET DIAXE2=DIAXFR("LE")
- DO E2
- +5 IF DIAXFR("TY")["D"
- IF DIAXTO("LO")>14
- SET DIAXE2=14
- DO E1
- DO E3
- +6 IF DIAXFR("TY")["D"
- IF DIAXTO("HI")<14
- SET DIAXE2=14
- DO E2
- +7 QUIT
- +8 ;
- N GOTO N^DIAXM3
- +1 ;
- D GOTO D^DIAXM3
- +1 ;
- P DO XT
- IF DIAXEXT
- DO P^DIAXM2
- if $DATA(DIAXMSG)!DIAXFR
- QUIT
- +1 DO HL^DIAXM(15,1)
- +2 QUIT
- +3 ;
- V DO XT
- IF DIAXEXT
- DO V^DIAXM2
- if $DATA(DIAXMSG)!DIAXFR
- QUIT
- +1 DO HL^DIAXM(30,3)
- +2 QUIT
- +3 ;
- C GOTO C^DIAXM2
- +1 ;
- S IF DIAXTO
- if '$DATA(DIAR)
- WRITE !?DIAXTAB,$CHAR(7),"Make sure the SET OF CODES are identical as the extract field."
- QUIT
- +1 DO XT
- DO S^DIAXM2
- +2 QUIT
- +3 ;
- W if DIAXFR
- QUIT
- +1 IF DIAXFR("TY")["L"
- IF DIAXTO("TY")'["L"
- DO E3
- SET DIAXEM=DIAXEM_"be in 'L'ine mode."
- DO X
- +2 QUIT
- +3 ;
- K QUIT
- +1 ;
- E1 SET DIAXE1="minimum"
- QUIT
- E2 SET DIAXE1="maximum"
- E3 SET DIAXEM=DIAXTO("NM")_" field in "_DIAXEF_$SELECT($DATA(DIAXSB):" subfile",1:" file")_" should "
- if DIAXFTY["W"
- QUIT
- +1 SET DIAXEM=DIAXEM_"have a "_DIAXE1_" length of at least "_DIAXE2_" characters."
- X DO ERR^DIAXERR(DIAXEM)
- +1 KILL DIAXE1,DIAXE2
- +2 QUIT
- +3 ;
- DJ SET DIAXDJ=DIAXDJ+1
- +1 SET ^UTILITY("DIFG",$JOB,DIAXC,DIAXDJ)=DIAXS_U_U_+Y_U_$PIECE(Y(0),U,4)_U_$GET(DIAXEXT)
- +2 SET S=DIAXS
- SET DJ=DIAXDJ
- SET C=DIAXC
- +3 QUIT
- +4 ;
- XT SET DIAXEXT=+$GET(DIAXEXT)
- IF '$DATA(DIAR)
- IF $DATA(DC(DC))
- SET DIAXEXT=+$PIECE(DC(DC),U,5)
- if 'DINS
- QUIT
- +1 if $DATA(DIAR)
- QUIT
- +2 KILL DIR
- NEW Y
- SET DIR(0)="Y"
- SET DIR("A")="Move EXTERNAL form of the data to the extract field"
- SET DIR("B")="Yes"
- SET DIR("?")="Answer YES if the RESOLVED value of data should be moved"
- +3 DO ^DIR
- KILL DIR
- if 'Y
- QUIT
- +4 SET DIAXEXT=1
- +5 QUIT
