HMPZ0218 ;ASMR/JCH - Clinical Procedures failing TIU patch quick fix ;Feb 18, 2015@14:29:52
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;Feb 18, 2015;Build 63
;Per VA Directive 6402, this routine should not be modified.
;
Q
;
; temporary fix for Clinical Procedures issue (User Story 5021)
DISABLE ;
;
D BMES^XPDUTL("Disabling INDEX entries for Clinical Procedures "_$$NOW),MES^XPDUTL("routine: "_$T(+0))
;
; HMPARY - IEN array for INDEX
; HMPINDX - target INDEX entry
N F,G,HMPARY,HMPINDX,I,J,Q,X,Y
;
S Q=$C(34)
F J=1:1 S HMPINDX=$P($T(INDXLST+J),";;",2,99) Q:HMPINDX="" D ; find INDEX file (#.11) entries
.D MES^XPDUTL("looking for INDEX: "_HMPINDX)
.N FL,I,NTRY,Y
.S NTRY=0 ; INDEX enrty IEN
.S FL=+$P(HMPINDX,U) ; file #
.S I=0 F S I=$O(^DD("IX","B",FL,I)) Q:'I!(NTRY) D ; find entry and save it
..S Y=$G(^DD("IX",I,0)) S:$P(HMPINDX,U,1,3)=$P(Y,U,1,3) NTRY=I,HMPINDX(FL,I)=Y,HMPINDX(0)=$G(HMPINDX(0))+1
;
I '($G(HMPINDX(0))=1) D Q ; must locate both entries, exit if not found
.D BMES^XPDUTL("Unable to find INDEX file entries"),MES^XPDUTL("exiting routine "_$T(+0)_" "_$$NOW)
;
S F=0 F S F=$O(HMPINDX(F)) Q:'F D
.N GLB,ND,UPDT
.S I=+$O(HMPINDX(F,0)) Q:'I
.S GLB=$NA(^DD("IX",I,0)),Y=$G(@GLB) D BMES^XPDUTL("examining "_GLB),MES^XPDUTL(" "_Q_Y_Q)
.S UPDT=0 ; updated flag, false if index not changed
.F ND=1,2 D
..S Y=$G(^DD("IX",I,ND)),GLB=$NA(^(ND))
..D MES^XPDUTL("value found in "_GLB_" was: "),MES^XPDUTL(" "_Q_Y_Q)
..I $E(Y)'="Q" S UPDT=1,Y="Q ;"_Y
..S:UPDT @GLB=Y
..D MES^XPDUTL($S(UPDT:"updated to "_Q_Y_Q,1:"* NOT CHANGED *"))
;
;
D BMES^XPDUTL("INDEX entry completed "_$$NOW)
;
Q
;
NOW() ; extrinsic variable, now in external format
Q $$HTE^XLFDT($H)
;
INDXLST ; *S68 - disable of AEVT index on file 8925 removed US5074
;;702^AVPR^Trigger updates to VPR^
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPZ0218 1887 printed Dec 13, 2024@01:54:57 Page 2
HMPZ0218 ;ASMR/JCH - Clinical Procedures failing TIU patch quick fix ;Feb 18, 2015@14:29:52
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;Feb 18, 2015;Build 63
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ; temporary fix for Clinical Procedures issue (User Story 5021)
DISABLE ;
+1 ;
+2 DO BMES^XPDUTL("Disabling INDEX entries for Clinical Procedures "_$$NOW)
DO MES^XPDUTL("routine: "_$TEXT(+0))
+3 ;
+4 ; HMPARY - IEN array for INDEX
+5 ; HMPINDX - target INDEX entry
+6 NEW F,G,HMPARY,HMPINDX,I,J,Q,X,Y
+7 ;
+8 SET Q=$CHAR(34)
+9 ; find INDEX file (#.11) entries
FOR J=1:1
SET HMPINDX=$PIECE($TEXT(INDXLST+J),";;",2,99)
if HMPINDX=""
QUIT
Begin DoDot:1
+10 DO MES^XPDUTL("looking for INDEX: "_HMPINDX)
+11 NEW FL,I,NTRY,Y
+12 ; INDEX enrty IEN
SET NTRY=0
+13 ; file #
SET FL=+$PIECE(HMPINDX,U)
+14 ; find entry and save it
SET I=0
FOR
SET I=$ORDER(^DD("IX","B",FL,I))
if 'I!(NTRY)
QUIT
Begin DoDot:2
+15 SET Y=$GET(^DD("IX",I,0))
if $PIECE(HMPINDX,U,1,3)=$PIECE(Y,U,1,3)
SET NTRY=I
SET HMPINDX(FL,I)=Y
SET HMPINDX(0)=$GET(HMPINDX(0))+1
End DoDot:2
End DoDot:1
+16 ;
+17 ; must locate both entries, exit if not found
IF '($GET(HMPINDX(0))=1)
Begin DoDot:1
+18 DO BMES^XPDUTL("Unable to find INDEX file entries")
DO MES^XPDUTL("exiting routine "_$TEXT(+0)_" "_$$NOW)
End DoDot:1
QUIT
+19 ;
+20 SET F=0
FOR
SET F=$ORDER(HMPINDX(F))
if 'F
QUIT
Begin DoDot:1
+21 NEW GLB,ND,UPDT
+22 SET I=+$ORDER(HMPINDX(F,0))
if 'I
QUIT
+23 SET GLB=$NAME(^DD("IX",I,0))
SET Y=$GET(@GLB)
DO BMES^XPDUTL("examining "_GLB)
DO MES^XPDUTL(" "_Q_Y_Q)
+24 ; updated flag, false if index not changed
SET UPDT=0
+25 FOR ND=1,2
Begin DoDot:2
+26 SET Y=$GET(^DD("IX",I,ND))
SET GLB=$NAME(^(ND))
+27 DO MES^XPDUTL("value found in "_GLB_" was: ")
DO MES^XPDUTL(" "_Q_Y_Q)
+28 IF $EXTRACT(Y)'="Q"
SET UPDT=1
SET Y="Q ;"_Y
+29 if UPDT
SET @GLB=Y
+30 DO MES^XPDUTL($SELECT(UPDT:"updated to "_Q_Y_Q,1:"* NOT CHANGED *"))
End DoDot:2
End DoDot:1
+31 ;
+32 ;
+33 DO BMES^XPDUTL("INDEX entry completed "_$$NOW)
+34 ;
+35 QUIT
+36 ;
NOW() ; extrinsic variable, now in external format
+1 QUIT $$HTE^XLFDT($HOROLOG)
+2 ;
INDXLST ; *S68 - disable of AEVT index on file 8925 removed US5074
+1 ;;702^AVPR^Trigger updates to VPR^
+2 ;
