Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YTXCHGT

YTXCHGT.m

Go to the documentation of this file. 
  1. YTXCHGT ;SLC/KCM - JSON / Tree Conversions ; 9/15/2015
  1.  ;;5.01;MENTAL HEALTH;**121,123,130,202**;Dec 30, 1994;Build 47
  1.  ;
  1.  ; Reference to VPRJSON supported by IA #6411
  1.  ;
  1.  ; SRC,DEST are global or local array references
  1.  ;
  1. MHA2TR(TEST,DEST) ; Load MHA test into DEST tree
  1.  D EXPORT^YTXCHGE(TEST,DEST)
  1.  Q
  1. TR2MHA(TREE,YTXDRY) ; Save SRC tree into MHA file entries
  1.  ;   TREE: closed reference to node that represents 1 instrument
  1.  ; YTXDRY: defined and true if this is just a dry run
  1.  N SEQ,PREFIX,TESTNM,NEWDT
  1.  S PREFIX=$S($G(YTXDRY):"Trial install for ",1:"Installing ")
  1.  S SEQ=0 F  S SEQ=$O(@TREE@("test",SEQ)) Q:'SEQ  D
  1.  . N YTXLOG S YTXLOG=1
  1.  . S TESTNM=@TREE@("test",SEQ,"info","name")
  1.  . D LOG^YTXCHGU("info",PREFIX_TESTNM)
  1.  . ; if not a dry run, do a test pass first and look for conflicts
  1.  . I '$G(YTXDRY) D IMPTREE^YTXCHGI($NA(@TREE@("test",SEQ)),2)
  1.  . I $G(YTXLOG("conflict")) D SHOSUMM^YTXCHGP(.YTXLOG,1) QUIT
  1.  . ; do a dry run or actual pass
  1.  . K YTXLOG S YTXLOG=1
  1.  . I '$G(YTXDRY) D BACKUP^YTXCHGU(@TREE@("test",SEQ,"info","name"))
  1.  . D IMPTREE^YTXCHGI($NA(@TREE@("test",SEQ)),YTXDRY)
  1.  . D SHOSUMM^YTXCHGP(.YTXLOG,YTXDRY)
  1.  . D LOG^YTXCHGU("info",$S($G(DRYRUN):"Trial install",1:"Installation")_" complete."_$S($G(DRYRUN):"  (No changes made)",1:""))
  1.  . Q:$G(YTXDRY)
  1.  . S NEWDT=@TREE@("test",SEQ,"info","lastEditDate")
  1.  . I ($G(YTXLOG("added"))+$G(YTXLOG("updated")))>0 D NEWDATE^YTXCHGU(TESTNM,NEWDT)
  1.  . D FILE96^YTWJSONF(@TREE@("test",SEQ,"info","name")) ; move new instrument to 601.96
  1.  Q
  1. TR2JSON(SRC,DEST) ; Convert tree representation to JSON
  1.  N JSONERR,INTERIM,OK
  1.  S INTERIM=$NA(^TMP("YTXCHG",$J,"INTERIM"))
  1.  K @INTERIM
  1.  I $E(DEST)=U,($E(DEST,1,4)'="^TMP") K @DEST  ; empty DEST
  1.  D ENCODE^VPRJSON(SRC,INTERIM,"JSONERR")
  1.  I $D(JSONERR) D LOG^YTXCHGU("error","JSON encode, "_$G(JSONERR(1))) Q 0
  1.  D SPLITLN(INTERIM,DEST) ; split into smaller lines for Fileman
  1.  K @INTERIM
  1.  Q 1
  1.  ;
  1. JSON2TR(SRC,DEST) ; Convert JSON to tree representation
  1.  ; returns 1 if converted without error
  1.  ;  SRC contains JSON representation
  1.  ; DEST is $NA value and should be empty
  1.  N JSONERR
  1.  D DECODE^VPRJSON(SRC,DEST,"JSONERR")
  1.  I $D(JSONERR) D LOG^YTXCHGU("error","JSON decode, "_$G(JSONERR(1))) Q 0
  1.  Q 1
  1.  ;
  1. SPEC2TR(XCHGIEN,DEST) ; Convert JSON WP entry in 601.95 to tree representation
  1.  ; returns 1 if converted without error
  1.  ; DEST is $NA value and should be empty
  1.  K ^TMP("YTXCHG",$J,"JSONTMP")
  1.  N I,JSONERR
  1.  ; convert main specification from JSON to TREE
  1.  S I=0 F  S I=$O(^YTT(601.95,XCHGIEN,1,I)) Q:'I  S ^TMP("YTXCHG",$J,"JSONTMP",I)=^YTT(601.95,XCHGIEN,1,I,0)
  1.  D DECODE^VPRJSON($NA(^TMP("YTXCHG",$J,"JSONTMP")),DEST,"JSONERR")
  1.  K ^TMP("YTXCHG",$J,"JSONTMP")
  1.  I $D(JSONERR) D LOG^YTXCHGU("error","JSON decode, "_$G(JSONERR(1))) Q 0
  1.  D ADDEND(XCHGIEN)
  1.  Q 1
  1.  ;
  1. ADDEND(XCHGIEN) ; Process any contents in addendum
  1.  ; example: {"ignoreConflicts": ["601.72:6488","601.72:6491","601.72:6734"]}
  1.  N I,X,ARRAY
  1.  D ADD2TR(XCHGIEN,.ARRAY) Q:'$D(ARRAY)
  1.  K ^XTMP("YTXIDX","ignore")
  1.  S I=0 F  S I=$O(ARRAY("ignoreConflicts",I)) Q:'I  D
  1.  . S X=ARRAY("ignoreConflicts",I)
  1.  . S ^XTMP("YTXIDX","ignore",+$P(X,":"),+$P(X,":",2))=""
  1.  Q
  1. CHKSCORE(XCHGIEN) ; Check addendum for instruments that should be re-scored
  1.  ; example: {"rescoreInstruments":["PCL-5"]}
  1.  N I,X,ARRAY,IEN,REV
  1.  D ADD2TR(XCHGIEN,.ARRAY) Q:'$D(ARRAY)
  1.  S I=0 F  S I=$O(ARRAY("rescoreInstruments",I)) Q:'I  D
  1.  . S X=ARRAY("rescoreInstruments",I)
  1.  . S IEN=$O(^YTT(601.71,"B",X,0)) Q:'IEN
  1.  . S REV=$P($G(^YTT(601.71,IEN,9)),U,3) Q:'REV
  1.  . D QTASK^YTSCOREV(IEN_"~"_REV,($H+1)_",3600") ; queue rescoring (T+1@1am)
  1.  Q
  1. ADD2TR(XCHGIEN,ARRAY) ; Load Addendum JSON into TREE
  1.  N I,JSONTMP,JSONERR
  1.  S I=0 F  S I=$O(^YTT(601.95,XCHGIEN,4,I)) Q:'I  S JSONTMP(I)=^YTT(601.95,XCHGIEN,4,I,0)
  1.  Q:'$D(JSONTMP)
  1.  D DECODE^VPRJSON("JSONTMP","ARRAY","JSONERR")
  1.  I $D(JSONERR) D LOG^YTXCHGU("error","Addendum decode, "_$G(JSONERR(1))) Q
  1.  Q
  1. JSON2WP(SRC,DEST) ; Convert JSON array (n) to WP array (n,0)
  1.  N I
  1.  S I=0 F  S I=$O(@SRC@(I)) Q:'I  S @DEST@(I,0)=@SRC@(I)
  1.  Q
  1. WP2TR(SRC,DEST) ; Convert FM WP field to tree representation
  1.  ;  SRC: glvn of source array
  1.  ; DEST: glvn of destination array
  1.  I $E(DEST)=U,($E(DEST,1,4)'="^TMP") K @DEST  ; empty DEST
  1.  N LN S LN=0
  1.  F  S LN=$O(@SRC@(LN)) Q:'LN  D
  1.  . I LN=1 S @DEST=@SRC@(LN,0) I 1
  1.  . E  S @DEST@("\",LN-1)=$C(13,10)_@SRC@(LN,0)
  1.  Q
  1. TR2WP(SRC,DEST) ; Convert tree representation to FM WP
  1.  ;  SRC: glvn of source array (JSON node with wp text)
  1.  ; DEST: glvn of destination array (will add [line,0] nodes)
  1.  N I,J,X,LN
  1.  S LN=0,X=$TR($G(@SRC),$C(13))  ; drop CR and only parse on LF
  1.  F J=1:1:$L(X,$C(10)) S LN=LN+1,@DEST@(LN,0)=$P(X,$C(10),J)
  1.  S I=0 F  S I=$O(@SRC@("\",I)) Q:'I  D
  1.  . S X=$TR(@SRC@("\",I),$C(13)) ; drop CR and only parse on LF (in \ nodes)
  1.  . F J=1:1:$L(X,$C(10)) D
  1.  . . I J=1 S @DEST@(LN,0)=@DEST@(LN,0)_$P(X,$C(10),1) I 1
  1.  . . E  S LN=LN+1,@DEST@(LN,0)=$P(X,$C(10),J)
  1.  Q
  1. SPLITLN(SRC,DEST,MAX) ; Split JSON lines into lines of MAX length
  1.  N I,LN,X
  1.  S MAX=$G(MAX,240) S:MAX'>0 MAX=240 ; MAX default is 240
  1.  S LN=0,I=0 F  S I=$O(@SRC@(I)) Q:'I  D
  1.  . S X=@SRC@(I)
  1.  . F  S LN=LN+1,@DEST@(LN)=$E(X,1,MAX),X=$E(X,MAX+1,99999) Q:'$L(X)
  1.  Q
  1.  ;
  1. TEST2WP ; test TR2WP entry point
  1.  N JSON,TEXT
  1.  S JSON("wp")="This is line 1."_$C(13,10)_"This is line 2."_$C(13,10)_"This is "
  1.  S JSON("wp","\",1)="line 3."_$C(13,10)_"This is line 4."_$C(13,10)_"This is line "
  1.  S JSON("wp","\",2)="5."_$C(13,10)_"This is the last line."
  1.  D TR2WP($NA(JSON("wp")),$NA(TEXT(2)))
  1.  ; ZW TEXT
  1.  Q