EASEZPVU ;ALB/GTS/CMF - MT PICKER FOR EZ/EZR PRINT
;;1.0;ENROLLMENT APPLICATION SYSTEM;**57**;Mar 15, 2001
;
Q
PICK(EASDFN,EASMTIEN) ;validate or pick mtien for printing
; Input: EASDFN - POINTER TO PATIENT FILE (#2) - required
; EASMTIEN - POINTER TO MEANS TEST FILE (#408.31 - optional
; Output: RESULT - valid mt pointer, or null
N RESULT,MTIEN,DIC,D,X,Y,DTOUT,DUOUT,EASSORT
S RESULT=""
; if means test ien, then return it
S MTIEN=$G(EASMTIEN)
S MTIEN=$S($D(^DGMT(408.31,+MTIEN)):+MTIEN,MTIEN=0:0,MTIEN=-1:-1,1:"")
I (+MTIEN>0)!(MTIEN=-1) Q MTIEN
;
; if no means test ien, then ask user for one
D GETMTDAT(EASDFN)
I $D(EASSORT) D
.;display sort array here!
.D DISPLAY
.;lookup filtered by sort array
.S DIC=408.31
.S DIC(0)="AEMQ"
.S DIC("A")="Select DATE OF TEST:"
.S DIC("S")="I $D(EASSORT($P(^(0),U),Y))"
.S D="ADFN"_EASDFN_"^B"
.D MIX^DIC1
.S RESULT=+Y
Q RESULT
;
GETMTDAT(EASDFN) ;sort primary tests for printing selection
;
; Input: EASDFN - Patient file IEN (DFN)
; Output: EASSORT - Array of Means Tests in the following format:
; EASSORT(DATE,MTIEN)=MT IEN^Date of Test^Status Name^Status Code^Source
;
;check for futures
; means test
D SORT($$FUT^DGMTU(EASDFN,,1),"NO")
; copay test
D SORT($$FUT^DGMTU(EASDFN,,2),"NO")
; ltc copay exemption test
D SORT($$FUT^DGMTU(EASDFN,,4),"NO")
;look for current
; means test
D SORT($$LST^DGMTU(EASDFN,,1),"YES")
; copay test
D SORT($$LST^DGMTU(EASDFN,,2),"YES")
; ltc copay exemption test
D SORT($$LST^DGMTU(EASDFN,,4),"YES")
Q
;
SORT(RETURN,PRIMARY) ;sort mt status string
N DATE,MTIEN
I +RETURN=0 Q
S DATE=$P(RETURN,U,2)
S MTIEN=$P(RETURN,U,1)
S:$$GET1^DIQ(408.31,MTIEN_",",2)=PRIMARY EASSORT(DATE,MTIEN)=RETURN
Q
;
DISPLAY ; eassort array
N MTDT,MTIEN,MTIENS
W !?3,"Choose from:"
S MTDT=""
F S MTDT=$O(EASSORT(MTDT)) Q:MTDT="" D
.S MTIEN=""
.F S MTIEN=$O(EASSORT(MTDT,MTIEN)) Q:MTIEN="" D
..S MTIENS=MTIEN_","
..W !?3,MTDT_" "
..W $$GET1^DIQ(408.31,MTIENS,.01)_" " ;test date
..W $$GET1^DIQ(408.31,MTIENS,.019)_" " ;type of test
..W $$GET1^DIQ(408.31,MTIENS,.03)_" " ;status
..W $$GET1^DIQ(408.31,MTIENS,.23)_" " ;source of test
..W $S($$GET1^DIQ(408.31,MTIENS,2)="YES":"PRIMARY",1:"NOT PRIMARY")
..Q
.Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASEZPVU 2345 printed Apr 09, 2024@20:59:18 Page 2
EASEZPVU ;ALB/GTS/CMF - MT PICKER FOR EZ/EZR PRINT
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**57**;Mar 15, 2001
+2 ;
+3 QUIT
PICK(EASDFN,EASMTIEN) ;validate or pick mtien for printing
+1 ; Input: EASDFN - POINTER TO PATIENT FILE (#2) - required
+2 ; EASMTIEN - POINTER TO MEANS TEST FILE (#408.31 - optional
+3 ; Output: RESULT - valid mt pointer, or null
+4 NEW RESULT,MTIEN,DIC,D,X,Y,DTOUT,DUOUT,EASSORT
+5 SET RESULT=""
+6 ; if means test ien, then return it
+7 SET MTIEN=$GET(EASMTIEN)
+8 SET MTIEN=$SELECT($DATA(^DGMT(408.31,+MTIEN)):+MTIEN,MTIEN=0:0,MTIEN=-1:-1,1:"")
+9 IF (+MTIEN>0)!(MTIEN=-1)
QUIT MTIEN
+10 ;
+11 ; if no means test ien, then ask user for one
+12 DO GETMTDAT(EASDFN)
+13 IF $DATA(EASSORT)
Begin DoDot:1
+14 ;display sort array here!
+15 DO DISPLAY
+16 ;lookup filtered by sort array
+17 SET DIC=408.31
+18 SET DIC(0)="AEMQ"
+19 SET DIC("A")="Select DATE OF TEST:"
+20 SET DIC("S")="I $D(EASSORT($P(^(0),U),Y))"
+21 SET D="ADFN"_EASDFN_"^B"
+22 DO MIX^DIC1
+23 SET RESULT=+Y
End DoDot:1
+24 QUIT RESULT
+25 ;
GETMTDAT(EASDFN) ;sort primary tests for printing selection
+1 ;
+2 ; Input: EASDFN - Patient file IEN (DFN)
+3 ; Output: EASSORT - Array of Means Tests in the following format:
+4 ; EASSORT(DATE,MTIEN)=MT IEN^Date of Test^Status Name^Status Code^Source
+5 ;
+6 ;check for futures
+7 ; means test
+8 DO SORT($$FUT^DGMTU(EASDFN,,1),"NO")
+9 ; copay test
+10 DO SORT($$FUT^DGMTU(EASDFN,,2),"NO")
+11 ; ltc copay exemption test
+12 DO SORT($$FUT^DGMTU(EASDFN,,4),"NO")
+13 ;look for current
+14 ; means test
+15 DO SORT($$LST^DGMTU(EASDFN,,1),"YES")
+16 ; copay test
+17 DO SORT($$LST^DGMTU(EASDFN,,2),"YES")
+18 ; ltc copay exemption test
+19 DO SORT($$LST^DGMTU(EASDFN,,4),"YES")
+20 QUIT
+21 ;
SORT(RETURN,PRIMARY) ;sort mt status string
+1 NEW DATE,MTIEN
+2 IF +RETURN=0
QUIT
+3 SET DATE=$PIECE(RETURN,U,2)
+4 SET MTIEN=$PIECE(RETURN,U,1)
+5 if $$GET1^DIQ(408.31,MTIEN_",",2)=PRIMARY
SET EASSORT(DATE,MTIEN)=RETURN
+6 QUIT
+7 ;
DISPLAY ; eassort array
+1 NEW MTDT,MTIEN,MTIENS
+2 WRITE !?3,"Choose from:"
+3 SET MTDT=""
+4 FOR
SET MTDT=$ORDER(EASSORT(MTDT))
if MTDT=""
QUIT
Begin DoDot:1
+5 SET MTIEN=""
+6 FOR
SET MTIEN=$ORDER(EASSORT(MTDT,MTIEN))
if MTIEN=""
QUIT
Begin DoDot:2
+7 SET MTIENS=MTIEN_","
+8 WRITE !?3,MTDT_" "
+9 ;test date
WRITE $$GET1^DIQ(408.31,MTIENS,.01)_" "
+10 ;type of test
WRITE $$GET1^DIQ(408.31,MTIENS,.019)_" "
+11 ;status
WRITE $$GET1^DIQ(408.31,MTIENS,.03)_" "
+12 ;source of test
WRITE $$GET1^DIQ(408.31,MTIENS,.23)_" "
+13 WRITE $SELECT($$GET1^DIQ(408.31,MTIENS,2)="YES":"PRIMARY",1:"NOT PRIMARY")
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 QUIT
+17 ;
