- 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 Mar 13, 2025@20:59:40 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 ;
