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

YTXCHGV.m

Go to the documentation of this file. 
  1. YTXCHGV ;SLC/KCM - Instrument Specification Validation ; 9/15/2015
  1.  ;;5.01;MENTAL HEALTH;**121**;Dec 30, 1994;Build 61
  1.  ;
  1. IDXALL ; Index all tests
  1.  N TEST,CNT,XCHGIDX
  1.  S CNT=1,XCHGIDX=1 ; XCHGIDX is flag to build full index
  1.  D LOG^YTXCHGU("info","Gathering installed instruments")
  1.  L +^XTMP("YTXIDX"):60 E  Q
  1.  K ^XTMP("YTXIDX")
  1.  S ^XTMP("YTXIDX",0)=$$FMADD^XLFDT(DT,1)_U_DT_U_"MH Instrument Combined Index"
  1.  S TEST=0 F  S TEST=$O(^YTT(601.71,TEST)) Q:'TEST  D
  1.  . S CNT=CNT+1
  1.  . W:'(CNT#10) "."
  1.  . D BLDTEST(TEST)
  1.  L -^XTMP("YTXIDX")
  1.  Q
  1. ADDIDX(FILE,IEN,TEST) ; add entry to full index
  1.  N XCHGIDX S XCHGIDX=1
  1.  L +^XTMP("YTXIDX",FILE):DILOCKTM E  Q
  1.  D SETP(FILE,IEN)
  1.  L -^XTMP("YTXIDX",FILE)
  1.  Q
  1. DELIDX(FILE,IEN,TEST) ; remove entry from full index
  1.  L +^XTMP("YTXIDX",FILE):DILOCKTM E  Q
  1.  K ^XTMP("YTXIDX",FILE,IEN,TEST)
  1.  L -^XTMP("YTXIDX",FILE)
  1.  Q
  1. COLLIDE(FILE,IEN) ; return 1 if there is a collision with another instrument
  1.  ; expects TSTIEN to be the IEN of the current instrument
  1.  I '$G(TSTIEN) Q 0  ; no test to compare with
  1.  I $D(^XTMP("YTXIDX","ignore",FILE,IEN)) Q 0  ; ignore collision
  1.  N I,X
  1.  S X=""
  1.  S I=0 F  S I=$O(^XTMP("YTXIDX",FILE,IEN,I)) Q:'I  I I'=TSTIEN D
  1.  . S X=X_$S($L(X):",",1:"")_$P(^YTT(601.71,I,0),U)
  1.  I $L(X) D LOG^YTXCHGU("conflict",FILE_":"_IEN_" used by "_X)
  1.  Q $S($L(X):1,1:0)
  1.  ;
  1. ISONLY(FILE,IEN,TSTIEN) ; return 1 if TEST is only user of FILE:IEN
  1.  N I,CNT
  1.  S CNT=0
  1.  S I=0 F  S I=$O(^XTMP("YTXIDX",FILE,IEN,I)) Q:'I  I I'=TSTIEN S CNT=CNT+1
  1.  Q:'CNT 1
  1.  Q 0
  1.  ;
  1. BLDTEST(TEST,GBLROOT) ; Assemble IEN's used by TEST
  1.  D SETP(601.71,TEST)
  1.  ; MH INSTRUMENT CONTENT loop
  1.  N IC,XC0,IQ,XQ2,ICT,XCT,XCT0
  1.  S IC=0 F  S IC=$O(^YTT(601.76,"AC",TEST,IC)) Q:'IC  D
  1.  . S XC0=$G(^YTT(601.76,IC,0)),IQ=+$P(XC0,U,4)
  1.  . D SETP(601.76,IC)                           ; content entry
  1.  . D SETP(601.72,IQ)                           ; question entry
  1.  . D SETP(601.88,+$P(XC0,U,6))                 ; question display
  1.  . D SETP(601.88,+$P(XC0,U,7))                 ; intro display
  1.  . D SETP(601.88,+$P(XC0,U,8))                 ; choice display
  1.  . S XQ2=$G(^YTT(601.72,IQ,2)),XCT=+$P(XQ2,U,3)
  1.  . D SETP(601.73,+$P(XQ2,U))                   ; intro entry
  1.  . D SETP(601.89,+$O(^YTT(601.89,"B",XCT,0)))  ; choice identifier entry
  1.  . S ICT=0 F  S ICT=$O(^YTT(601.751,"B",XCT,ICT)) Q:'ICT  D
  1.  . . D SETP(601.751,ICT)                       ; choicetype entry
  1.  . . S XCT0=$G(^YTT(601.751,ICT,0))
  1.  . . D SETP(601.75,+$P(XCT0,U,3))              ; choice entry
  1.  ; MH SCALEGROUPS loop
  1.  N IG,XG0,IS,XS0,IK
  1.  S IG=0 F  S IG=$O(^YTT(601.86,"AD",TEST,IG)) Q:'IG  D
  1.  . S XG0=$G(^YTT(601.86,IG,0))
  1.  . D SETP(601.86,IG)                           ; scalegroup entry
  1.  . S IS=0 F  S IS=$O(^YTT(601.87,"AD",IG,IS)) Q:'IS  D
  1.  . . S XS0=$G(^YTT(601.87,IS,0))
  1.  . . D SETP(601.87,IS)                         ; scale entry
  1.  . . S IK=0 F  S IK=$O(^YTT(601.91,"AC",IS,IK)) Q:'IK  D
  1.  . . . D SETP(601.91,IK)                       ; scoring key entry
  1.  ; MH SECTIONS loop
  1.  N I,X0
  1.  S I=0 F  S I=$O(^YTT(601.81,"AC",TEST,I)) Q:'I  D
  1.  . S X0=$G(^YTT(601.81,I,0))
  1.  . D SETP(601.81,I)                            ; section entry
  1.  . D SETP(601.72,+$P(X0,U,3))                  ; question entry
  1.  . D SETP(601.88,+$P(X0,U,6))                  ; section display
  1.  ; MH INSTRUMENTRULES loop
  1.  S I=0 F  S I=$O(^YTT(601.83,"C",TEST,I)) Q:'I  D
  1.  . S X0=$G(^YTT(601.83,I,0))
  1.  . D SETP(601.83,I)                            ; instrumentrule entry
  1.  . D SETP(601.72,+$P(X0,U,3))                  ; question entry
  1.  . D SETP(601.82,+$P(X0,U,4))                  ; rule entry
  1.  ; MH SKIPPED QUESTIONS loop
  1.  S I=0 F  S I=$O(^YTT(601.79,"AC",TEST,I)) Q:'I  D
  1.  . S X0=$G(^YTT(601.79,I,0))
  1.  . D SETP(601.79,I)                            ; skipped question entry
  1.  . D SETP(601.82,+$P(X0,U,3))                  ; rule entry
  1.  . D SETP(601.72,+$P(X0,U,4))                  ; question entry
  1.  Q
  1. SETP(FILE,IEN) ; Set file,ien pair in global
  1.  ; expects XCHGIDX (for cross-file index) or GBLROOT
  1.  Q:'IEN
  1.  Q:'$D(^YTT(FILE,IEN,0))
  1.  I $G(XCHGIDX) S ^XTMP("YTXIDX",FILE,IEN,TEST)="" QUIT
  1.  S @GBLROOT@(FILE,IEN)=""
  1.  Q
  1.  ;
  1.  ;
  1. VERIFY(TREE,YTXERRS,YTXDELS) ; Verify no conflicts, find records to remove
  1.  ;    TREE: global reference for instruments being installed
  1.  ;     SEQ: identifies which instrument
  1.  ;  ERRORS: contains up to 6 instances of record conflicts
  1.  ; DELETES: lists entries that may be deleted
  1.  ;
  1.  N TEST,ENTRY,FILE,IEN,X
  1.  S TEST=@TREE@("info","name")
  1.  S TEST=$O(^YTT(601.71,"B",TEST,0))
  1.  Q:'TEST
  1.  K ^TMP($J,"local")
  1.  D BLDTEST(TEST)
  1.  ;
  1.  ; look for entries that locally might belong to another instrument
  1.  S ENTRY=0,YTXERRS=0
  1.  F  S ENTRY=$O(@TREE@("verify",ENTRY)) Q:'ENTRY  D  Q:YTXERRS>5
  1.  . S X=@TREE@("verify",ENTRY),FILE=$P(X,":"),IEN=$P(X,":",2)
  1.  . I '$$CHKNODE(FILE,IEN) D
  1.  . . S YTXERRS=YTXERRS+1
  1.  . . S YTXERRS(YTXERRS)="Entry "_FILE_":"_IEN_" belongs to another test"
  1.  ;
  1.  ; look for local entries that should be deleted
  1.  S ENTRY=0,YTXDELS=0
  1.  F  S ENTRY=$O(@TREE@("verify",ENTRY)) Q:'ENTRY  D
  1.  . S X=@TREE@("verify",ENTRY),FILE=$P(X,":"),IEN=$P(X,":",2)
  1.  . K ^TMP($J,"local",FILE,IEN)
  1.  S FILE=0 F  S FILE=$O(^TMP($J,"local",FILE)) Q:'FILE  D
  1.  . S IEN=0 F  S IEN=$O(^TMP($J,"local",FILE,IEN)) Q:'IEN  D
  1.  . . S YTXDELS=YTXDELS+1
  1.  . . S YTXDELS(FILE,IEN)=""
  1.  ;
  1.  K ^TMP($J,"local")
  1.  Q
  1. CHKNODE(FILE,IEN) ; Check to see if node belongs to same test
  1.  I '$D(^YTT(FILE,IEN,0)) Q -1         ; not found, node will be added
  1.  I $D(^TMP($J,"local",FILE,IEN)) Q 1  ; same test, node may be updated
  1.  Q 0                                  ; node present, different test
  1.  ;
  1. BELONG(FILE,IEN) ; Return line of instruments this entry belongs to
  1.  N TEST,X
  1.  S X=""
  1.  S TEST=0 F  S TEST=$O(^XTMP("YTXIDX",FILE,IEN,TEST)) Q:'TEST  D
  1.  . S X=X_$S($L(X):",",1:"")_$P(^YTT(601.71,TEST,0),U)
  1.  Q X
  1.  ;