- DITCP0 ;GFT/MSC - COMPARE ACROSS UCIs OR COMPARE TWO ENTRIES ;16MAR2016
- ;;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.
- ;
- UCI ;Compare across UCI's FILEMAN OPTION 9, SUBOPTION 3
- N DITCPI,DIC,DIR,DITCPUCI,DIRUT,DIB,DITCPT
- S Y=$$WUCI Q:Y="" D DT^DICRW,L^DICRW1 Q:'$D(DIC)
- S DITCPI=+Y,DIR(0)="F^1:90",DIR("A")="Compare to what UCI",DIR("B")=$G(^DOPT("DITCPUCI",DUZ))
- I $G(^DD("OS"))=18 S DIR("?")="^D UCIQ^DITCP0"
- D ^DIR
- D:'$D(DISYS) OS^DII
- Q:U[X S Y="" X:X'["," $G(^DD("OS",DISYS,"UCICHECK")) I 0[Y W !!,X," IS NOT A VALID UCI!" Q
- S ^DOPT("DITCPUCI",DUZ)=X,DITCPUCI=X
- K DIR S DIR(0)="S^1:DATA DICTIONARY ONLY;2:FILE ENTRIES ONLY;3:DATA DICTIONARY AND FILE ENTRIES",DIR("B")=3 D ^DIR
- Q:U[X S DIB=Y
- D START Q:IO=""
- S DIR=DITCPI
- DD K DITCPT
- I DIB#2 D EN^DITCP("^DD("_DITCPI_")","^["""_DITCPUCI_"""]DD("_DITCPI_")",0,1,.DITCPT) F X=0:0 S X=$O(^DD(DITCPI,"SB",X)) Q:'X S DITCPI(X)=""
- I '$D(DIRUT) S DITCPI=$O(DITCPI(0)) I DITCPI K DITCPI(DITCPI) G DD
- FILES S X=$G(DITCPT) K DITCPT S DITCPT=X
- I '$D(DIRUT),DIB>1,$D(^DIC(DIR)) S X=$$CREF^DILF(^DIC(DIR,0,"GL")) D EN^DITCP(X,"^["""_DITCPUCI_"""]"_$P(X,U,2,9),DIR,1,.DITCPT)
- I '$D(DIRUT) S DIR=$O(^DIC(DIR)) I DIR,DIR'>DIB(1) K DITCPI S DITCPI=DIR G DD
- C G CLOSE^DIO4
- ;
- ;
- UCIQ ;HELP
- N L W !?4,"CHOOSE FROM:" D ;***CACHE-SPECIFIC FROM %NSP
- .X "n gft,UCI f UCI=1:1:$zu(90,0) s gft=$zu(90,2,0,UCI) s:$l(gft) L(gft)=0"
- S L="" F S L=$O(L(L)) Q:L="" W !?8,L
- Q
- ;
- ;
- ENTRIES ;Compare entries in a File
- N D1,D2,DIRUT,DITCP
- I $D(DIU) S DIC=DIU
- E D R^DICRW Q:'$D(DIC)
- S DIC(0)="AEQM" D ^DIC Q:Y<0 S DITCP=+Y,DIC("A")="Select a SECOND: ",DIC("S")="I Y-"_+Y D ^DIC K DIC("S"),DIC("A") Q:Y<0
- S D1=DIC_DITCP_")",D2=DIC_+Y_")",DIDD=+$P(@(DIC_"0)"),U,2)
- D START Q:IO=""
- D EN^DITCP(D1,D2,DIDD,"2N")
- G C
- ;
- ;
- ;
- START ;
- W !,"DISPLAY COMPARISON ON" K %ZIS D ^%ZIS K POP Q:IO="" U IO
- D DT^DICRW S Y=DT D DD^%DT W !,Y I $D(^DD("SITE")) W ?14,^("SITE") S Y=$$WUCI
- I $D(DITCPUCI) S %=$L(DITCPUCI) W ?$S(IOM\2>%:IOM\2,1:IOM-%),"UCI: "_DITCPUCI
- W ! F %=1:1:IOM W "-"
- Q
- ;
- WUCI() ;
- N Y I ^DD("OS")=19!(^DD("OS")=17) X "S Y=$ZGD" ;GTM GLOBAL DIRECTORY
- E I $D(^%ZOSF("UCI"))#2 X ^("UCI")
- I $D(Y) W !?2,"UCI: "_Y Q Y
- Q ""
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDITCP0 2502 printed Mar 13, 2025@21:59:04 Page 2
- DITCP0 ;GFT/MSC - COMPARE ACROSS UCIs OR COMPARE TWO ENTRIES ;16MAR2016
- +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 ;
- UCI ;Compare across UCI's FILEMAN OPTION 9, SUBOPTION 3
- +1 NEW DITCPI,DIC,DIR,DITCPUCI,DIRUT,DIB,DITCPT
- +2 SET Y=$$WUCI
- if Y=""
- QUIT
- DO DT^DICRW
- DO L^DICRW1
- if '$DATA(DIC)
- QUIT
- +3 SET DITCPI=+Y
- SET DIR(0)="F^1:90"
- SET DIR("A")="Compare to what UCI"
- SET DIR("B")=$GET(^DOPT("DITCPUCI",DUZ))
- +4 IF $GET(^DD("OS"))=18
- SET DIR("?")="^D UCIQ^DITCP0"
- +5 DO ^DIR
- +6 if '$DATA(DISYS)
- DO OS^DII
- +7 if U[X
- QUIT
- SET Y=""
- if X'[","
- XECUTE $GET(^DD("OS",DISYS,"UCICHECK"))
- IF 0[Y
- WRITE !!,X," IS NOT A VALID UCI!"
- QUIT
- +8 SET ^DOPT("DITCPUCI",DUZ)=X
- SET DITCPUCI=X
- +9 KILL DIR
- SET DIR(0)="S^1:DATA DICTIONARY ONLY;2:FILE ENTRIES ONLY;3:DATA DICTIONARY AND FILE ENTRIES"
- SET DIR("B")=3
- DO ^DIR
- +10 if U[X
- QUIT
- SET DIB=Y
- +11 DO START
- if IO=""
- QUIT
- +12 SET DIR=DITCPI
- DD KILL DITCPT
- +1 IF DIB#2
- DO EN^DITCP("^DD("_DITCPI_")","^["""_DITCPUCI_"""]DD("_DITCPI_")",0,1,.DITCPT)
- FOR X=0:0
- SET X=$ORDER(^DD(DITCPI,"SB",X))
- if 'X
- QUIT
- SET DITCPI(X)=""
- +2 IF '$DATA(DIRUT)
- SET DITCPI=$ORDER(DITCPI(0))
- IF DITCPI
- KILL DITCPI(DITCPI)
- GOTO DD
- FILES SET X=$GET(DITCPT)
- KILL DITCPT
- SET DITCPT=X
- +1 IF '$DATA(DIRUT)
- IF DIB>1
- IF $DATA(^DIC(DIR))
- SET X=$$CREF^DILF(^DIC(DIR,0,"GL"))
- DO EN^DITCP(X,"^["""_DITCPUCI_"""]"_$PIECE(X,U,2,9),DIR,1,.DITCPT)
- +2 IF '$DATA(DIRUT)
- SET DIR=$ORDER(^DIC(DIR))
- IF DIR
- IF DIR'>DIB(1)
- KILL DITCPI
- SET DITCPI=DIR
- GOTO DD
- C GOTO CLOSE^DIO4
- +1 ;
- +2 ;
- UCIQ ;HELP
- +1 ;***CACHE-SPECIFIC FROM %NSP
- NEW L
- WRITE !?4,"CHOOSE FROM:"
- Begin DoDot:1
- +2 XECUTE "n gft,UCI f UCI=1:1:$zu(90,0) s gft=$zu(90,2,0,UCI) s:$l(gft) L(gft)=0"
- End DoDot:1
- +3 SET L=""
- FOR
- SET L=$ORDER(L(L))
- if L=""
- QUIT
- WRITE !?8,L
- +4 QUIT
- +5 ;
- +6 ;
- ENTRIES ;Compare entries in a File
- +1 NEW D1,D2,DIRUT,DITCP
- +2 IF $DATA(DIU)
- SET DIC=DIU
- +3 IF '$TEST
- DO R^DICRW
- if '$DATA(DIC)
- QUIT
- +4 SET DIC(0)="AEQM"
- DO ^DIC
- if Y<0
- QUIT
- SET DITCP=+Y
- SET DIC("A")="Select a SECOND: "
- SET DIC("S")="I Y-"_+Y
- DO ^DIC
- KILL DIC("S"),DIC("A")
- if Y<0
- QUIT
- +5 SET D1=DIC_DITCP_")"
- SET D2=DIC_+Y_")"
- SET DIDD=+$PIECE(@(DIC_"0)"),U,2)
- +6 DO START
- if IO=""
- QUIT
- +7 DO EN^DITCP(D1,D2,DIDD,"2N")
- +8 GOTO C
- +9 ;
- +10 ;
- +11 ;
- START ;
- +1 WRITE !,"DISPLAY COMPARISON ON"
- KILL %ZIS
- DO ^%ZIS
- KILL POP
- if IO=""
- QUIT
- USE IO
- +2 DO DT^DICRW
- SET Y=DT
- DO DD^%DT
- WRITE !,Y
- IF $DATA(^DD("SITE"))
- WRITE ?14,^("SITE")
- SET Y=$$WUCI
- +3 IF $DATA(DITCPUCI)
- SET %=$LENGTH(DITCPUCI)
- WRITE ?$SELECT(IOM\2>%:IOM\2,1:IOM-%),"UCI: "_DITCPUCI
- +4 WRITE !
- FOR %=1:1:IOM
- WRITE "-"
- +5 QUIT
- +6 ;
- WUCI() ;
- +1 ;GTM GLOBAL DIRECTORY
- NEW Y
- IF ^DD("OS")=19!(^DD("OS")=17)
- XECUTE "S Y=$ZGD"
- +2 IF '$TEST
- IF $DATA(^%ZOSF("UCI"))#2
- XECUTE ^("UCI")
- +3 IF $DATA(Y)
- WRITE !?2,"UCI: "_Y
- QUIT Y
- +4 QUIT ""
