GMVUID ;HIOFO/FT-VUID-RELATED UTILITIES ;5/3/05 11:48
;;5.0;GEN. MED. REC. - VITALS;**8**;Oct 31, 2002
;
; This routine uses the following IAs:
; #2263 - XPAR calls (supported)
; #4631 - XTID calls (supported)
; #10070 - ^XMD (supported)
; #4640 - ^HDISVF01 (supported)
;
EN(ERROR) ; Clean up existing file connections and gui templates
;
I ERROR D QMAIL Q
N FILE,OK
S OK=1
F FILE=120.51,120.52,120.53 I '$$SCREEN^HDISVF01(FILE) S OK=0
Q:'OK
D QUAL,CAT,TEMPS
Q
QMAIL ; Queue mail message
N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
S ZTRTN="MAIL^GMVUID",ZTDESC="GMRV VITALS VUID ERROR"
S ZTIO="",ZTDTH=$H
D ^%ZTLOAD
Q
MAIL ; Send mail message to installer that an error occurred
N GMVMSG,XMDUZ,XMSUB,XMTEXT,XMY
S XMY(DUZ)=""
S XMDUZ=.5 ;message sender
S XMSUB="ERROR IN VITALS VUID UPDATE"
S GMVMSG(1)="An error occurred while updating the VUID data for the"
S GMVMSG(2)="GEN. MED. REC. - VITALS package files. "
S GMVMSG(3)=" "
S GMVMSG(4)="Please log a Remedy ticket immediately. "
S XMTEXT="GMVMSG("
D ^XMD
Q
QUAL ; Loop through the Qualifier entries in FILE 120.52:
; 1) If the QUALIFIER is not active, get rid of all VITAL TYPE (#1)
; associations,
; 2) If the QUALIFIER is active and a VITAL TYPE is not active, get rid
; of that VITAL TYPE association,
; 3) If the QUALIFIER and VITAL TYPE are active, but the CATEGORY
; (#.02 in subfile 120.521) is not, get rid of that subfile entry.
;
N GMVNODE,GMVQUAL,GMVT
S GMVQUAL=0
F S GMVQUAL=$O(^GMRD(120.52,GMVQUAL)) Q:'GMVQUAL D
.I $$ACTIVE(120.52,"",GMVQUAL_",","") D Q ;see #1 above
..S GMVT=0
..F S GMVT=$O(^GMRD(120.52,GMVQUAL,1,GMVT)) Q:'GMVT D
...D QUAL1(GMVQUAL,GMVT)
...Q
..Q
.S GMVT=0
.F S GMVT=$O(^GMRD(120.52,GMVQUAL,1,GMVT)) Q:'GMVT D
..S GMVNODE=$G(^GMRD(120.52,GMVQUAL,1,GMVT,0))
..S GMVTY=$$ACTIVE(120.51,"",+$P(GMVNODE,U)_",","")
..I GMVTY D
...D QUAL1(GMVQUAL,GMVT)
...Q
..I 'GMVTY D
...S GMVNODE=$G(^GMRD(120.52,GMVQUAL,1,GMVT,0))
...Q:GMVNODE=""
...I $$ACTIVE(120.53,"",$P(GMVNODE,U,2)_",","") D
....D QUAL1(GMVQUAL,GMVT)
....Q
...Q
..Q
.Q
Q
QUAL1(GMVX,GMVY) ; Delete a multiple entry (#1) in FILE 120.52
N DA,DIK
S DA(1)=GMVX,DA=GMVY,DIK="^GMRD(120.52,"_DA(1)_",1,"
D ^DIK
Q
CAT ; Loop through the Category entries in FILE 120.53:
; 1) If the CATEGORY is not active, get rid of all VITAL TYPE (#1)
; associations,
; 2) If the CATEGORY is active and a VITAL TYPE is not active, get rid
; of that VITAL TYPE association,
; 3) If the CATEGORY and VITAL TYPE are active, but the DEFAULT
; QUALIFIER (#.07) is not, null out the DEFAULT QUALIFIER field.
;
N GMVCAT,GMVNODE,GMVT,GMVTI,GMVTY
S GMVCAT=0
F S GMVCAT=$O(^GMRD(120.53,GMVCAT)) Q:'GMVCAT D
.I $$ACTIVE(120.53,"",GMVCAT_",","") D Q ;see #1 sbove
..S GMVT=0
..F S GMVT=$O(^GMRD(120.53,GMVCAT,1,GMVT)) Q:'GMVT D
..D CAT1(GMVCAT,GMVT)
..Q
.;The CATEGORY is active, but check if the VITAL TYPE is active.
.S GMVT=0
.F S GMVT=$O(^GMRD(120.53,GMVCAT,1,GMVT)) Q:'GMVT D
..S GMVTI=+$P($G(^GMRD(120.53,GMVCAT,1,GMVT,0)),U,1)
..S GMVTY=$$ACTIVE(120.51,"",GMVTI_",","")
..I GMVTY D ;see #2 above
...D CAT1(GMVCAT,GMVT)
...Q
..I 'GMVTY D
...S GMVNODE=$G(^GMRD(120.53,GMVCAT,1,GMVT,0))
...Q:GMVNODE=""
...Q:$P(GMVNODE,U,7)=""
...I $$ACTIVE(120.52,"",$P(GMVNODE,U,7)_",","") D ;see #3 above
....D CAT2(GMVCAT,GMVT)
....Q
...Q
..Q
.Q
Q
CAT1(GMVX,GMVY) ; Delete a multiple entry (#1) in FILE 120.53
N DA,DIK
S DA(1)=GMVX,DA=GMVY,DIK="^GMRD(120.53,"_DA(1)_",1,"
D ^DIK
Q
CAT2(GMVX,GMVY) ; Delete a default qualifier
Q:'GMVX
Q:'GMVY
S $P(^GMRD(120.53,GMVX,1,GMVY,0),U,7)=""
Q
ACTIVE(GMVFILE,GMVFLD,GMVIEN,GMVDATE) ; Calls the $$SCREEN^XTID API to get VUID status
; Input: GMVFILE - File number
; GMVFLD - Field number
; GMVIEN - IEN
; GMVDATE - Date
; Output: 0 - Active
; 1 - Inactive
Q $$SCREEN^XTID(GMVFILE,GMVFLD,GMVIEN,GMVDATE)
;
GET(GMVFILE,GMVIEN,GMVREF) ; Calls the $$GETVUID^XTID API to get the VUID number
; GMVFILE - File number
; GMVIEN - field #
; GMVREF - value
N GMVUID
S GMVUID=$$GETVUID^XTID(GMVFILE,GMVIEN,GMVREF)
Q $P(GMVUID,U,1)
;
TEMPS ; Clean up GUI templates definitions.
; If a qualifier is inactive, remove it and its category.
N GMV,GMV1,GMV2,GMVDESC,GMVERR,GMVI,GMVJ,GMVLIST,GMVNEW,GMVNODE,GMVOLD,GMVORIG,GMVQUAL,GMVX,GMVY
K ^TMP($J)
S GMVLIST=$NA(^TMP($J))
D ENVAL^XPAR(.GMVLIST,"GMV TEMPLATE","","",1)
Q:'$D(^TMP($J))
S GMV1="" ; ien;file
F S GMV1=$O(^TMP($J,GMV1)) Q:GMV1="" D
.S GMV2="" ;template name
.F S GMV2=$O(^TMP($J,GMV1,GMV2)) Q:GMV2="" D
..S (GMVNODE,GMVORIG)=$G(^TMP($J,GMV1,GMV2))
..Q:GMVNODE=""
..S GMVDESC=$P(GMVNODE,"|",1) ;template description
..S GMVNODE=$P(GMVNODE,"|",2)
..K GMV ;array of vital types
..F GMVI=1:1 Q:$P(GMVNODE,";",GMVI)="" S GMV(GMVI)=$P(GMVNODE,";",GMVI)
..S GMVI=0
..F S GMVI=$O(GMV(GMVI)) Q:'GMVI D
...S GMVX=GMV(GMVI)
...Q:GMVX=""
...S GMVY=$P(GMVX,":",1,2) ;vital ien:metric indicator
...S GMVX=$P(GMVX,":",3) ;~categories,qualifiers~
...Q:GMVX=""
...S GMVNEW=""
...F GMVJ=1:1 Q:$P(GMVX,"~",GMVJ)="" D
....S GMVOLD=$P(GMVX,"~",GMVJ) ;each category & qualifier combo
....S GMVQUAL=$P(GMVOLD,",",2) ;qualifier
....I '$$ACTIVE(120.52,"",GMVQUAL_",",""),$$COMBO($P(GMVY,":",1),GMVQUAL,$P(GMVOLD,",",1)) S GMVNEW=GMVNEW_GMVOLD_"~" ;active qualifier & right combination of type, qualifier and category
...I $E(GMVNEW,$L(GMVNEW))="~" S GMVNEW=$E(GMVNEW,1,($L(GMVNEW)-1))
...S:GMVNEW]"" GMVNEW=GMVY_":"_GMVNEW
...S:GMVNEW="" GMVNEW=GMVY
...S GMV(GMVI)=GMVNEW
..S GMVI=0,GMVNODE=GMVDESC_"|"
..F S GMVI=$O(GMV(GMVI)) Q:'GMVI D
...S GMVNODE=GMVNODE_GMV(GMVI)_";"
...Q
..I $E(GMVNODE,$L(GMVNODE))=";" S GMVNODE=$E(GMVNODE,1,($L(GMVNODE)-1))
..I $E(GMVNODE,$L(GMVNODE))="|" S GMVNODE=$E(GMVNODE,1,($L(GMVNODE)-1))
..I GMVNODE=GMVORIG Q ;no change in template
..D EN^XPAR(GMV1,"GMV TEMPLATE",GMV2,GMVNODE,.GMVERR)
..Q
.Q
K ^TMP($J)
Q
COMBO(GMVTI,GMVQUALI,GMVCATI) ; Check if this combination is in the AA cross-
; reference of File 120.52
; Input:
; GMVTI - File 120.51 ien
; GMVQUALI - File 120.52 ien
; GMVCATI - File 120.53 ien
N GMVFLAG,GMVQUALE
S GMVFLAG=0
S GMVTI=+$G(GMVTI),GMVQUALI=+$G(GMVQUALI),GMVCATI=+$G(GMVCATI)
I 'GMVTI!(GMVQUALI'>0)!(GMVCATI'>0) Q GMVFLAG
S GMVQUALE=$P($G(^GMRD(120.52,GMVQUALI,0)),U,1)
I GMVQUALE="" Q GMVFLAG
I $D(^GMRD(120.52,"AA",GMVTI,GMVCATI,GMVQUALE,GMVQUALI)) S GMVFLAG=1
Q GMVFLAG
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMVUID 6673 printed Sep 02, 2024@18:45:14 Page 2
GMVUID ;HIOFO/FT-VUID-RELATED UTILITIES ;5/3/05 11:48
+1 ;;5.0;GEN. MED. REC. - VITALS;**8**;Oct 31, 2002
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #2263 - XPAR calls (supported)
+5 ; #4631 - XTID calls (supported)
+6 ; #10070 - ^XMD (supported)
+7 ; #4640 - ^HDISVF01 (supported)
+8 ;
EN(ERROR) ; Clean up existing file connections and gui templates
+1 ;
+2 IF ERROR
DO QMAIL
QUIT
+3 NEW FILE,OK
+4 SET OK=1
+5 FOR FILE=120.51,120.52,120.53
IF '$$SCREEN^HDISVF01(FILE)
SET OK=0
+6 if 'OK
QUIT
+7 DO QUAL
DO CAT
DO TEMPS
+8 QUIT
QMAIL ; Queue mail message
+1 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
+2 SET ZTRTN="MAIL^GMVUID"
SET ZTDESC="GMRV VITALS VUID ERROR"
+3 SET ZTIO=""
SET ZTDTH=$HOROLOG
+4 DO ^%ZTLOAD
+5 QUIT
MAIL ; Send mail message to installer that an error occurred
+1 NEW GMVMSG,XMDUZ,XMSUB,XMTEXT,XMY
+2 SET XMY(DUZ)=""
+3 ;message sender
SET XMDUZ=.5
+4 SET XMSUB="ERROR IN VITALS VUID UPDATE"
+5 SET GMVMSG(1)="An error occurred while updating the VUID data for the"
+6 SET GMVMSG(2)="GEN. MED. REC. - VITALS package files. "
+7 SET GMVMSG(3)=" "
+8 SET GMVMSG(4)="Please log a Remedy ticket immediately. "
+9 SET XMTEXT="GMVMSG("
+10 DO ^XMD
+11 QUIT
QUAL ; Loop through the Qualifier entries in FILE 120.52:
+1 ; 1) If the QUALIFIER is not active, get rid of all VITAL TYPE (#1)
+2 ; associations,
+3 ; 2) If the QUALIFIER is active and a VITAL TYPE is not active, get rid
+4 ; of that VITAL TYPE association,
+5 ; 3) If the QUALIFIER and VITAL TYPE are active, but the CATEGORY
+6 ; (#.02 in subfile 120.521) is not, get rid of that subfile entry.
+7 ;
+8 NEW GMVNODE,GMVQUAL,GMVT
+9 SET GMVQUAL=0
+10 FOR
SET GMVQUAL=$ORDER(^GMRD(120.52,GMVQUAL))
if 'GMVQUAL
QUIT
Begin DoDot:1
+11 ;see #1 above
IF $$ACTIVE(120.52,"",GMVQUAL_",","")
Begin DoDot:2
+12 SET GMVT=0
+13 FOR
SET GMVT=$ORDER(^GMRD(120.52,GMVQUAL,1,GMVT))
if 'GMVT
QUIT
Begin DoDot:3
+14 DO QUAL1(GMVQUAL,GMVT)
+15 QUIT
End DoDot:3
+16 QUIT
End DoDot:2
QUIT
+17 SET GMVT=0
+18 FOR
SET GMVT=$ORDER(^GMRD(120.52,GMVQUAL,1,GMVT))
if 'GMVT
QUIT
Begin DoDot:2
+19 SET GMVNODE=$GET(^GMRD(120.52,GMVQUAL,1,GMVT,0))
+20 SET GMVTY=$$ACTIVE(120.51,"",+$PIECE(GMVNODE,U)_",","")
+21 IF GMVTY
Begin DoDot:3
+22 DO QUAL1(GMVQUAL,GMVT)
+23 QUIT
End DoDot:3
+24 IF 'GMVTY
Begin DoDot:3
+25 SET GMVNODE=$GET(^GMRD(120.52,GMVQUAL,1,GMVT,0))
+26 if GMVNODE=""
QUIT
+27 IF $$ACTIVE(120.53,"",$PIECE(GMVNODE,U,2)_",","")
Begin DoDot:4
+28 DO QUAL1(GMVQUAL,GMVT)
+29 QUIT
End DoDot:4
+30 QUIT
End DoDot:3
+31 QUIT
End DoDot:2
+32 QUIT
End DoDot:1
+33 QUIT
QUAL1(GMVX,GMVY) ; Delete a multiple entry (#1) in FILE 120.52
+1 NEW DA,DIK
+2 SET DA(1)=GMVX
SET DA=GMVY
SET DIK="^GMRD(120.52,"_DA(1)_",1,"
+3 DO ^DIK
+4 QUIT
CAT ; Loop through the Category entries in FILE 120.53:
+1 ; 1) If the CATEGORY is not active, get rid of all VITAL TYPE (#1)
+2 ; associations,
+3 ; 2) If the CATEGORY is active and a VITAL TYPE is not active, get rid
+4 ; of that VITAL TYPE association,
+5 ; 3) If the CATEGORY and VITAL TYPE are active, but the DEFAULT
+6 ; QUALIFIER (#.07) is not, null out the DEFAULT QUALIFIER field.
+7 ;
+8 NEW GMVCAT,GMVNODE,GMVT,GMVTI,GMVTY
+9 SET GMVCAT=0
+10 FOR
SET GMVCAT=$ORDER(^GMRD(120.53,GMVCAT))
if 'GMVCAT
QUIT
Begin DoDot:1
+11 ;see #1 sbove
IF $$ACTIVE(120.53,"",GMVCAT_",","")
Begin DoDot:2
+12 SET GMVT=0
+13 FOR
SET GMVT=$ORDER(^GMRD(120.53,GMVCAT,1,GMVT))
if 'GMVT
QUIT
Begin DoDot:3
End DoDot:3
+14 DO CAT1(GMVCAT,GMVT)
+15 QUIT
End DoDot:2
QUIT
+16 ;The CATEGORY is active, but check if the VITAL TYPE is active.
+17 SET GMVT=0
+18 FOR
SET GMVT=$ORDER(^GMRD(120.53,GMVCAT,1,GMVT))
if 'GMVT
QUIT
Begin DoDot:2
+19 SET GMVTI=+$PIECE($GET(^GMRD(120.53,GMVCAT,1,GMVT,0)),U,1)
+20 SET GMVTY=$$ACTIVE(120.51,"",GMVTI_",","")
+21 ;see #2 above
IF GMVTY
Begin DoDot:3
+22 DO CAT1(GMVCAT,GMVT)
+23 QUIT
End DoDot:3
+24 IF 'GMVTY
Begin DoDot:3
+25 SET GMVNODE=$GET(^GMRD(120.53,GMVCAT,1,GMVT,0))
+26 if GMVNODE=""
QUIT
+27 if $PIECE(GMVNODE,U,7)=""
QUIT
+28 ;see #3 above
IF $$ACTIVE(120.52,"",$PIECE(GMVNODE,U,7)_",","")
Begin DoDot:4
+29 DO CAT2(GMVCAT,GMVT)
+30 QUIT
End DoDot:4
+31 QUIT
End DoDot:3
+32 QUIT
End DoDot:2
+33 QUIT
End DoDot:1
+34 QUIT
CAT1(GMVX,GMVY) ; Delete a multiple entry (#1) in FILE 120.53
+1 NEW DA,DIK
+2 SET DA(1)=GMVX
SET DA=GMVY
SET DIK="^GMRD(120.53,"_DA(1)_",1,"
+3 DO ^DIK
+4 QUIT
CAT2(GMVX,GMVY) ; Delete a default qualifier
+1 if 'GMVX
QUIT
+2 if 'GMVY
QUIT
+3 SET $PIECE(^GMRD(120.53,GMVX,1,GMVY,0),U,7)=""
+4 QUIT
ACTIVE(GMVFILE,GMVFLD,GMVIEN,GMVDATE) ; Calls the $$SCREEN^XTID API to get VUID status
+1 ; Input: GMVFILE - File number
+2 ; GMVFLD - Field number
+3 ; GMVIEN - IEN
+4 ; GMVDATE - Date
+5 ; Output: 0 - Active
+6 ; 1 - Inactive
+7 QUIT $$SCREEN^XTID(GMVFILE,GMVFLD,GMVIEN,GMVDATE)
+8 ;
GET(GMVFILE,GMVIEN,GMVREF) ; Calls the $$GETVUID^XTID API to get the VUID number
+1 ; GMVFILE - File number
+2 ; GMVIEN - field #
+3 ; GMVREF - value
+4 NEW GMVUID
+5 SET GMVUID=$$GETVUID^XTID(GMVFILE,GMVIEN,GMVREF)
+6 QUIT $PIECE(GMVUID,U,1)
+7 ;
TEMPS ; Clean up GUI templates definitions.
+1 ; If a qualifier is inactive, remove it and its category.
+2 NEW GMV,GMV1,GMV2,GMVDESC,GMVERR,GMVI,GMVJ,GMVLIST,GMVNEW,GMVNODE,GMVOLD,GMVORIG,GMVQUAL,GMVX,GMVY
+3 KILL ^TMP($JOB)
+4 SET GMVLIST=$NAME(^TMP($JOB))
+5 DO ENVAL^XPAR(.GMVLIST,"GMV TEMPLATE","","",1)
+6 if '$DATA(^TMP($JOB))
QUIT
+7 ; ien;file
SET GMV1=""
+8 FOR
SET GMV1=$ORDER(^TMP($JOB,GMV1))
if GMV1=""
QUIT
Begin DoDot:1
+9 ;template name
SET GMV2=""
+10 FOR
SET GMV2=$ORDER(^TMP($JOB,GMV1,GMV2))
if GMV2=""
QUIT
Begin DoDot:2
+11 SET (GMVNODE,GMVORIG)=$GET(^TMP($JOB,GMV1,GMV2))
+12 if GMVNODE=""
QUIT
+13 ;template description
SET GMVDESC=$PIECE(GMVNODE,"|",1)
+14 SET GMVNODE=$PIECE(GMVNODE,"|",2)
+15 ;array of vital types
KILL GMV
+16 FOR GMVI=1:1
if $PIECE(GMVNODE,";",GMVI)=""
QUIT
SET GMV(GMVI)=$PIECE(GMVNODE,";",GMVI)
+17 SET GMVI=0
+18 FOR
SET GMVI=$ORDER(GMV(GMVI))
if 'GMVI
QUIT
Begin DoDot:3
+19 SET GMVX=GMV(GMVI)
+20 if GMVX=""
QUIT
+21 ;vital ien:metric indicator
SET GMVY=$PIECE(GMVX,":",1,2)
+22 ;~categories,qualifiers~
SET GMVX=$PIECE(GMVX,":",3)
+23 if GMVX=""
QUIT
+24 SET GMVNEW=""
+25 FOR GMVJ=1:1
if $PIECE(GMVX,"~",GMVJ)=""
QUIT
Begin DoDot:4
+26 ;each category & qualifier combo
SET GMVOLD=$PIECE(GMVX,"~",GMVJ)
+27 ;qualifier
SET GMVQUAL=$PIECE(GMVOLD,",",2)
+28 ;active qualifier & right combination of type, qualifier and category
IF '$$ACTIVE(120.52,"",GMVQUAL_",","")
IF $$COMBO($PIECE(GMVY,":",1),GMVQUAL,$PIECE(GMVOLD,",",1))
SET GMVNEW=GMVNEW_GMVOLD_"~"
End DoDot:4
+29 IF $EXTRACT(GMVNEW,$LENGTH(GMVNEW))="~"
SET GMVNEW=$EXTRACT(GMVNEW,1,($LENGTH(GMVNEW)-1))
+30 if GMVNEW]""
SET GMVNEW=GMVY_":"_GMVNEW
+31 if GMVNEW=""
SET GMVNEW=GMVY
+32 SET GMV(GMVI)=GMVNEW
End DoDot:3
+33 SET GMVI=0
SET GMVNODE=GMVDESC_"|"
+34 FOR
SET GMVI=$ORDER(GMV(GMVI))
if 'GMVI
QUIT
Begin DoDot:3
+35 SET GMVNODE=GMVNODE_GMV(GMVI)_";"
+36 QUIT
End DoDot:3
+37 IF $EXTRACT(GMVNODE,$LENGTH(GMVNODE))=";"
SET GMVNODE=$EXTRACT(GMVNODE,1,($LENGTH(GMVNODE)-1))
+38 IF $EXTRACT(GMVNODE,$LENGTH(GMVNODE))="|"
SET GMVNODE=$EXTRACT(GMVNODE,1,($LENGTH(GMVNODE)-1))
+39 ;no change in template
IF GMVNODE=GMVORIG
QUIT
+40 DO EN^XPAR(GMV1,"GMV TEMPLATE",GMV2,GMVNODE,.GMVERR)
+41 QUIT
End DoDot:2
+42 QUIT
End DoDot:1
+43 KILL ^TMP($JOB)
+44 QUIT
COMBO(GMVTI,GMVQUALI,GMVCATI) ; Check if this combination is in the AA cross-
+1 ; reference of File 120.52
+2 ; Input:
+3 ; GMVTI - File 120.51 ien
+4 ; GMVQUALI - File 120.52 ien
+5 ; GMVCATI - File 120.53 ien
+6 NEW GMVFLAG,GMVQUALE
+7 SET GMVFLAG=0
+8 SET GMVTI=+$GET(GMVTI)
SET GMVQUALI=+$GET(GMVQUALI)
SET GMVCATI=+$GET(GMVCATI)
+9 IF 'GMVTI!(GMVQUALI'>0)!(GMVCATI'>0)
QUIT GMVFLAG
+10 SET GMVQUALE=$PIECE($GET(^GMRD(120.52,GMVQUALI,0)),U,1)
+11 IF GMVQUALE=""
QUIT GMVFLAG
+12 IF $DATA(^GMRD(120.52,"AA",GMVTI,GMVCATI,GMVQUALE,GMVQUALI))
SET GMVFLAG=1
+13 QUIT GMVFLAG
+14 ;
