HMPELAB ;SLC/JMC,ASMR/RRB - Lab extract utilities;Nov 24, 2015 13:08:23
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;Sep 01, 1913;Build 63
;Per VA Directive 6402, this routine should not be modified.
;
Q
;
SHWORPNL ; Ordering panels (ends in "panel")
;
;DE2818, ICR 2387, fields being read are:
; ^LAB(60,D0,0)= (#.01) NAME [1F] ^
; ^LAB(60,D0,2,0)=^60.02P^^ (#200) LAB TEST INCLUDED IN PANEL
; ^LAB(60,D0,2,D1,0)= (#.01) LAB TEST [1P:60] ^ (#.02) AP MULTIPLY FACTOR [2N] ^
;
N X,COUNT,LABDAT
S X=$NA(^LAB(60))
F S X=$Q(@X) Q:($QS(X,1)'=60)!($QS(X,2)'=+$QS(X,2)) D
. I $QS(X,3)=0 D
. . I $D(LABDAT),COUNT>0 S HMPCNT=HMPCNT+1 D ADD^HMPEF("LABDAT") K LABDAT
. . S COUNT=0,LABDAT("name")=$P(@X,"^",1),LABDAT("uid")=$$SETUID^HMPUTILS("labpanel","",$QS(X,2))
. I $QS(X,3)=2,$QS(X,4)>0 D
. . S LABDAT("labs",$QS(X,4),"id")=@X,LABDAT("labs",$QS(X,4),"name")=$P(^LAB(60,+@X,0),"^",1),COUNT=COUNT+1
I $D(LABDAT),COUNT>0 S HMPCNT=HMPCNT+1 D ADD^HMPEF("LABDAT") K LABDAT
S HMPFINI=1
Q
;
SHWCUMR2 ; All Cumulative Reports and the labs they point to (for UI pick on labs view)
;
;DE2818, fields being read are:
;^LAB(64.5,D0,0)= (#.01) NAME [1F] ^
;^LAB(64.5,D0,1,0)=^64.51^^ (#10) MAJOR HEADER
;^LAB(64.5,D0,1,D1,0)= (#.01) MAJOR HEADER [1F] ^ (#5) MEDICAL CENTER [2F] ^
;^LAB(64.5,D0,1,D1,1,0)=^64.52I^^ (#10) MINOR HEADER
;^LAB(64.5,D0,1,D1,1,D2,0)= (#.01) MINOR HEADER [1F] ^ (#1) PROFILE SITE/SPECIMEN [2P:61] ^ (#2) TYPE OF DISPLAY [3S] ^ (#3)
; ==>LOCALE FIELD [4S] ^
;^LAB(64.5,D0,1,D1,1,D2,1,0)=^64.53IP^^ (#10) LAB TEST
;^LAB(64.5,D0,1,D1,1,D2,1,D3,0)= (#.01) LAB TEST [1P:60] ^ (#1) TEST FIELD LENGTH [2N] ^ (#2) PRINT TEST NAME [3F] ^ (#3) TEST
; ==>PRINT CODE [4F] ^ (#4) TEST LOCATION [5F] ^ (#5) DECIMAL PLACES [6N] ^
; and
;
;^LAB(60,D0,0)= (#.01) NAME [1F] ^
;
N X,LASTSUB,LASTLAB,LABDAT
S LASTSUB=0,LASTLAB=0,X=$NA(^LAB(64.5,1,1))
F S X=$Q(@X) Q:($QS(X,4)="B")!($QS(X,3)'=1)!($QS(X,2)'=1)!($QS(X,1)'=64.5) D
. I $QS(X,5)=0 D
. . I $D(LABDAT) S HMPCNT=HMPCNT+1 D ADD^HMPEF("LABDAT") K LABDAT
. . S LASTSUB=0,LASTLAB=0,LABDAT("name")=$P(@X,"^",1)
. I $QS(X,7)=0 S LASTSUB=LASTSUB+1,LASTLAB=0,LABDAT("uid")=$$SETUID^HMPUTILS("labgroup",,$QS(X,4)),LABDAT("groups",LASTSUB,"name")=$P(@X,"^",1)
. I $QS(X,9)=0 D
. . S LASTLAB=LASTLAB+1
. . S LABDAT("groups",LASTSUB,"labs",LASTLAB,"name")=$P(^LAB(60,$P(@X,"^",1),0),"^",1)
. . S LABDAT("groups",LASTSUB,"labs",LASTLAB,"id")=$P(@X,"^",1)
I $D(LABDAT) S HMPCNT=HMPCNT+1 D ADD^HMPEF("LABDAT") K LABDAT
S HMPFINI=1
Q
LABPNL ; Lab ordering panels
; {name:panelName,uid:panelUid,labs:[{id:labIEN,name:labName},...]}
N IEN
F S IEN=$O(^LAB(60,IEN)) Q:'IEN D
. N X0,LAB
. S X0=$G(^LAB(60,IEN,0))
. Q:"IB"'[$P(X0,U,3) ; not for ordering
. Q:'$O(^LAB(60,IEN,2,0)) ; not panel
. S LAB("name")=$P(X0,U)
. S LAB("uid")=$$SETUID^HMPUTILS("labpanel","",IEN)
. ; recursively expand to individual tests
. D ADD^HMPEF("LAB")
I 'IEN S HMPFINI=1
Q
;
;DE2818, code below removed as it does nothing
;LABGRP ; Lab groups on cumulative report
; {name:groupName,uid:groupUid,labs:[{name:labName,id:labIEN},...]}
;F S IEN=$O(^LAB(60,IEN)) Q:'IEN D
;. Q
;Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPELAB 3307 printed Oct 16, 2024@17:54:36 Page 2
HMPELAB ;SLC/JMC,ASMR/RRB - Lab extract utilities;Nov 24, 2015 13:08:23
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;Sep 01, 1913;Build 63
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
SHWORPNL ; Ordering panels (ends in "panel")
+1 ;
+2 ;DE2818, ICR 2387, fields being read are:
+3 ; ^LAB(60,D0,0)= (#.01) NAME [1F] ^
+4 ; ^LAB(60,D0,2,0)=^60.02P^^ (#200) LAB TEST INCLUDED IN PANEL
+5 ; ^LAB(60,D0,2,D1,0)= (#.01) LAB TEST [1P:60] ^ (#.02) AP MULTIPLY FACTOR [2N] ^
+6 ;
+7 NEW X,COUNT,LABDAT
+8 SET X=$NAME(^LAB(60))
+9 FOR
SET X=$QUERY(@X)
if ($QSUBSCRIPT(X,1)'=60)!($QSUBSCRIPT(X,2)'=+$QSUBSCRIPT(X,2))
QUIT
Begin DoDot:1
+10 IF $QSUBSCRIPT(X,3)=0
Begin DoDot:2
+11 IF $DATA(LABDAT)
IF COUNT>0
SET HMPCNT=HMPCNT+1
DO ADD^HMPEF("LABDAT")
KILL LABDAT
+12 SET COUNT=0
SET LABDAT("name")=$PIECE(@X,"^",1)
SET LABDAT("uid")=$$SETUID^HMPUTILS("labpanel","",$QSUBSCRIPT(X,2))
End DoDot:2
+13 IF $QSUBSCRIPT(X,3)=2
IF $QSUBSCRIPT(X,4)>0
Begin DoDot:2
+14 SET LABDAT("labs",$QSUBSCRIPT(X,4),"id")=@X
SET LABDAT("labs",$QSUBSCRIPT(X,4),"name")=$PIECE(^LAB(60,+@X,0),"^",1)
SET COUNT=COUNT+1
End DoDot:2
End DoDot:1
+15 IF $DATA(LABDAT)
IF COUNT>0
SET HMPCNT=HMPCNT+1
DO ADD^HMPEF("LABDAT")
KILL LABDAT
+16 SET HMPFINI=1
+17 QUIT
+18 ;
SHWCUMR2 ; All Cumulative Reports and the labs they point to (for UI pick on labs view)
+1 ;
+2 ;DE2818, fields being read are:
+3 ;^LAB(64.5,D0,0)= (#.01) NAME [1F] ^
+4 ;^LAB(64.5,D0,1,0)=^64.51^^ (#10) MAJOR HEADER
+5 ;^LAB(64.5,D0,1,D1,0)= (#.01) MAJOR HEADER [1F] ^ (#5) MEDICAL CENTER [2F] ^
+6 ;^LAB(64.5,D0,1,D1,1,0)=^64.52I^^ (#10) MINOR HEADER
+7 ;^LAB(64.5,D0,1,D1,1,D2,0)= (#.01) MINOR HEADER [1F] ^ (#1) PROFILE SITE/SPECIMEN [2P:61] ^ (#2) TYPE OF DISPLAY [3S] ^ (#3)
+8 ; ==>LOCALE FIELD [4S] ^
+9 ;^LAB(64.5,D0,1,D1,1,D2,1,0)=^64.53IP^^ (#10) LAB TEST
+10 ;^LAB(64.5,D0,1,D1,1,D2,1,D3,0)= (#.01) LAB TEST [1P:60] ^ (#1) TEST FIELD LENGTH [2N] ^ (#2) PRINT TEST NAME [3F] ^ (#3) TEST
+11 ; ==>PRINT CODE [4F] ^ (#4) TEST LOCATION [5F] ^ (#5) DECIMAL PLACES [6N] ^
+12 ; and
+13 ;
+14 ;^LAB(60,D0,0)= (#.01) NAME [1F] ^
+15 ;
+16 NEW X,LASTSUB,LASTLAB,LABDAT
+17 SET LASTSUB=0
SET LASTLAB=0
SET X=$NAME(^LAB(64.5,1,1))
+18 FOR
SET X=$QUERY(@X)
if ($QSUBSCRIPT(X,4)="B")!($QSUBSCRIPT(X,3)'=1)!($QSUBSCRIPT(X,2)'=1)!($QSUBSCRIPT(X,1)'=64.5)
QUIT
Begin DoDot:1
+19 IF $QSUBSCRIPT(X,5)=0
Begin DoDot:2
+20 IF $DATA(LABDAT)
SET HMPCNT=HMPCNT+1
DO ADD^HMPEF("LABDAT")
KILL LABDAT
+21 SET LASTSUB=0
SET LASTLAB=0
SET LABDAT("name")=$PIECE(@X,"^",1)
End DoDot:2
+22 IF $QSUBSCRIPT(X,7)=0
SET LASTSUB=LASTSUB+1
SET LASTLAB=0
SET LABDAT("uid")=$$SETUID^HMPUTILS("labgroup",,$QSUBSCRIPT(X,4))
SET LABDAT("groups",LASTSUB,"name")=$PIECE(@X,"^",1)
+23 IF $QSUBSCRIPT(X,9)=0
Begin DoDot:2
+24 SET LASTLAB=LASTLAB+1
+25 SET LABDAT("groups",LASTSUB,"labs",LASTLAB,"name")=$PIECE(^LAB(60,$PIECE(@X,"^",1),0),"^",1)
+26 SET LABDAT("groups",LASTSUB,"labs",LASTLAB,"id")=$PIECE(@X,"^",1)
End DoDot:2
End DoDot:1
+27 IF $DATA(LABDAT)
SET HMPCNT=HMPCNT+1
DO ADD^HMPEF("LABDAT")
KILL LABDAT
+28 SET HMPFINI=1
+29 QUIT
LABPNL ; Lab ordering panels
+1 ; {name:panelName,uid:panelUid,labs:[{id:labIEN,name:labName},...]}
+2 NEW IEN
+3 FOR
SET IEN=$ORDER(^LAB(60,IEN))
if 'IEN
QUIT
Begin DoDot:1
+4 NEW X0,LAB
+5 SET X0=$GET(^LAB(60,IEN,0))
+6 ; not for ordering
if "IB"'[$PIECE(X0,U,3)
QUIT
+7 ; not panel
if '$ORDER(^LAB(60,IEN,2,0))
QUIT
+8 SET LAB("name")=$PIECE(X0,U)
+9 SET LAB("uid")=$$SETUID^HMPUTILS("labpanel","",IEN)
+10 ; recursively expand to individual tests
+11 DO ADD^HMPEF("LAB")
End DoDot:1
+12 IF 'IEN
SET HMPFINI=1
+13 QUIT
+14 ;
+15 ;DE2818, code below removed as it does nothing
+16 ;LABGRP ; Lab groups on cumulative report
+17 ; {name:groupName,uid:groupUid,labs:[{name:labName,id:labIEN},...]}
+18 ;F S IEN=$O(^LAB(60,IEN)) Q:'IEN D
+19 ;. Q
+20 ;Q
