- VAFHLZMT ;ALB/MLI/LD - Creation of HL7 ZMT (means test) segment ; 22 Mar 93
- ;;5.3;Registration;**14,33,122,182**;Aug 13, 1993
- ;
- ; This routine returns the ZMT segment which contains means test
- ; data for a selected patient.
- ;
- EN(DFN,VAFSTR,VAFMTDT,VAFTYPE,SETID,DELETE,LIMIT) ; Entry point to get ZMT segment
- ;
- ; Input:
- ; DFN - as the IEN or corresponding patient in the PATIENT file
- ; VAFSTR - as string of segment fields needed separated by commas
- ; VAFMTDT - (optional) as date of desired means test (defaults to latest MT)
- ; VAFTYPE - (optional) as type of test: 1 - Means Test (default=1)
- ; 2 - Copay Test
- ; SETID - (optional) value to use for SEQ 1, the set id field (1 used
- ; as default if not passed.)
- ; DELETE - (optional, pass by reference) This array is used to
- ; indicate whether the segment is being used to notify of the
- ; the deletion of a means test, pharmacy copay test, or a
- ; hardship determinatin. If a means test or hardship is being
- ; deleted, then VAFTYPE must equal 1. If an Rx copay test is
- ; being deleted, then VAFTYPE must equal 2. The subscripts
- ; are as follows:
- ; DELETE("DATE OF TEST")=<date of test> - indicates
- ; the income year of the test that the deletion flags
- ; refer to
- ; DELETE("HARDSHIP") - if $G(DELETE("HARDSHIP"))=1 then the
- ; segment will be created to delete the hardship.
- ; DELETE("MT") - if $G(DELETE("MT"))=1 then
- ; the segment will be created to delete a means test.
- ; DELETE("RX")= if $G(DELETE("RX"))=1 then
- ; the segment will be created to delete a pharmacy
- ; copay test.
- ; LIMIT - (optional) if $G(LIMIT)=1 then this indicates that a test in
- ; a prior income year than indicated by the VAFMTDT parameter
- ; should NOT be returned in the ZMT segment
- ;
- ; ****Also assumes all HL7 variables are defined as returned ****
- ; by the INIT^HLTRANS call
- ;
- ; Output - string in the form of the DHCP HL7 ZMT segment
- ;
- ;
- N NODE,PRIM,X,Y,VAFY,NODE2
- ;
- I '$G(DFN)!($G(VAFSTR)']"") G QUIT
- S $P(VAFY,HLFS,22)="",VAFSTR=","_VAFSTR_","
- S VAFTYPE=$S($G(VAFTYPE):VAFTYPE,1:1)
- S VAFMTDT=$S($G(VAFMTDT):VAFMTDT,1:DT)
- S $P(VAFY,HLFS,1)=$S($G(SETID):SETID,1:1)
- S (NODE,NODE2,PRIM)=""
- ;
- ;handle deletions of a test
- I ($G(DELETE("MT"))=1),VAFTYPE=1 D G QUIT
- .S $P(VAFY,HLFS,2)=$$HLDATE^HLFNC(DELETE("DATE OF TEST")) ; MT Date
- .S $P(VAFY,HLFS,3)=HLQ
- .I ($G(DELETE("HARDSHIP"))=1) S $P(VAFY,HLFS,24)=HLQ
- .S $P(VAFY,HLFS,17)=VAFTYPE ; Type Of Test
- ;
- I ($G(DELETE("RX"))=1),VAFTYPE=2 D G QUIT
- .S $P(VAFY,HLFS,2)=$$HLDATE^HLFNC(DELETE("DATE OF TEST")) ; MT Date
- .S $P(VAFY,HLFS,3)=HLQ
- .S $P(VAFY,HLFS,17)=VAFTYPE ; Type Of Test
- ;
- S X=$$LST^DGMTU(DFN,VAFMTDT,$S($G(VAFTYPE):VAFTYPE,1:1))
- I +X S NODE=$G(^DGMT(408.31,+X,0)),PRIM=$G(^("PRIM")),NODE2=$G(^DGMT(408.31,+X,2))
- ;
- ;if $$LST^DGMTU returned the wrong income year than disregard it
- I ($G(LIMIT)=1),$E(VAFMTDT,1,3)'=$E(+NODE,1,3) S (NODE,NODE2,X,PRIM)=""
- ;
- I VAFSTR[",2," S $P(VAFY,HLFS,2)=$S(+NODE:$$HLDATE^HLFNC(+NODE),1:HLQ) ; MT Date
- I VAFSTR[",3," S X=$P($G(^DG(408.32,+$P(NODE,"^",3),0)),"^",2),$P(VAFY,HLFS,3)=$S(X]"":X,1:"") ; MT Status
- I VAFSTR[",4," S $P(VAFY,HLFS,4)=$S($P(NODE,"^",4)]"":$P(NODE,"^",4),1:HLQ) ; Income
- I VAFSTR[",5," S $P(VAFY,HLFS,5)=$S($P(NODE,"^",5)]"":$P(NODE,"^",5),1:HLQ) ; Net Worth
- I VAFSTR[",6," S $P(VAFY,HLFS,6)=$S($P(NODE,"^",10):$$HLDATE^HLFNC($P(NODE,"^",10)),1:HLQ) ; Adjudication Date/Time
- I VAFSTR[",7," S $P(VAFY,HLFS,7)=$$YN^VAFHLFNC($P(NODE,"^",11)) ; Agreed To Pay
- I VAFSTR[",8," S $P(VAFY,HLFS,8)=$S($P(NODE,"^",12):$P(NODE,"^",12),1:HLQ) ; Threshold A
- I VAFSTR[",9," S $P(VAFY,HLFS,9)=$S($P(NODE,"^",15)]"":$P(NODE,"^",15),1:HLQ) ; Deductible Expenses
- I VAFSTR[",10," S $P(VAFY,HLFS,10)=$S($P(NODE,"^",7):$$HLDATE^HLFNC($P(NODE,"^",7)),1:HLQ) ; Date/Time Completed
- I VAFSTR[",11," S $P(VAFY,HLFS,11)=$$YN^VAFHLFNC($P(NODE,"^",16)) ; Previous Year Means Test Threshold Flag
- I VAFSTR[",12," S $P(VAFY,HLFS,12)=$S($P(NODE,"^",18)]"":$P(NODE,"^",18),1:HLQ) ; Total Dependents
- I VAFSTR[",13," S $P(VAFY,HLFS,13)=$$YN^VAFHLFNC($P(NODE,"^",20)) ; Hardship
- I VAFSTR[",14," S $P(VAFY,HLFS,14)=$S($P(NODE,"^",21):$$HLDATE^HLFNC($P(NODE,"^",21)),1:HLQ) ; Hardship Review Date
- I VAFSTR[",15," S $P(VAFY,HLFS,15)=$S($P(NODE,"^",24):$$HLDATE^HLFNC($P(NODE,"^",24)),1:HLQ) ; Date Vet Signed Test
- I VAFSTR[",16," S $P(VAFY,HLFS,16)=$$YN^VAFHLFNC($P(NODE,"^",14)) ; Declines To Give Income Info
- I VAFSTR[",17," S $P(VAFY,HLFS,17)=$S($P(NODE,"^",19):$P(NODE,"^",19),1:VAFTYPE) ; Type Of Test
- I VAFSTR[",18," S $P(VAFY,HLFS,18)=$S($P(NODE,"^",23)]"":$P(NODE,"^",23),1:HLQ) ; Source Of Test
- I VAFSTR[",19," S $P(VAFY,HLFS,19)=$$YN^VAFHLFNC(PRIM) ; Primary Test?
- I VAFSTR[",20," S $P(VAFY,HLFS,20)=$S($P(NODE,"^",25):$$HLDATE^HLFNC($P(NODE,"^",25)),1:HLQ) ; Date IVM Verified MT Completed
- I VAFSTR[",21," S $P(VAFY,HLFS,21)=$$YN^VAFHLFNC($P(NODE,"^",26)) ; Refused To Sign
- ;
- ;
- I VAFSTR[",22," S $P(VAFY,HLFS,22)=$P(NODE2,"^",5) ;Site Conducting Test
- I VAFSTR[",23," S $P(VAFY,HLFS,23)=$P(NODE2,"^",4) ;Site Granting Hardship
- I VAFSTR[",24," S $P(VAFY,HLFS,24)=$S($P(NODE2,"^"):$$HLDATE^HLFNC($P(NODE2,"^")),1:"") ;Hardship Effective Date
- I VAFSTR[",25," S $P(VAFY,HLFS,25)=$S($P(NODE2,"^",2):$$HLDATE^HLFNC($P(NODE2,"^",2)),1:"") ;Dt/Tm Test Last Edited
- I VAFSTR[",26," S $P(VAFY,HLFS,26)=$S($P(NODE2,"^",3):$$GETCODE^DGMTH($P(NODE2,"^",3)),1:"") ; Test Determined Status
- ;
- ;can only transmit the deletion of a hardship if the segment is for a means test - and the income years must match if there is a means test
- ;
- I VAFTYPE=1,($G(DELETE("HARDSHIP"))=1),('(+NODE)!($E(DELETE("DATE OF TEST"),1,3)=$E((+NODE),1,3))) S $P(VAFY,HLFS,24)=HLQ
- ;
- QUIT Q "ZMT"_HLFS_$G(VAFY)
- VAFHLZMT ;ALB/MLI/LD - Creation of HL7 ZMT (means test) segment ; 22 Mar 93
- +1 ;;5.3;Registration;**14,33,122,182**;Aug 13, 1993
- +2 ;
- +3 ; This routine returns the ZMT segment which contains means test
- +4 ; data for a selected patient.
- +5 ;
- EN(DFN,VAFSTR,VAFMTDT,VAFTYPE,SETID,DELETE,LIMIT) ; Entry point to get ZMT segment
- +1 ;
- +2 ; Input:
- +3 ; DFN - as the IEN or corresponding patient in the PATIENT file
- +4 ; VAFSTR - as string of segment fields needed separated by commas
- +5 ; VAFMTDT - (optional) as date of desired means test (defaults to latest MT)
- +6 ; VAFTYPE - (optional) as type of test: 1 - Means Test (default=1)
- +7 ; 2 - Copay Test
- +8 ; SETID - (optional) value to use for SEQ 1, the set id field (1 used
- +9 ; as default if not passed.)
- +10 ; DELETE - (optional, pass by reference) This array is used to
- +11 ; indicate whether the segment is being used to notify of the
- +12 ; the deletion of a means test, pharmacy copay test, or a
- +13 ; hardship determinatin. If a means test or hardship is being
- +14 ; deleted, then VAFTYPE must equal 1. If an Rx copay test is
- +15 ; being deleted, then VAFTYPE must equal 2. The subscripts
- +16 ; are as follows:
- +17 ; DELETE("DATE OF TEST")=<date of test> - indicates
- +18 ; the income year of the test that the deletion flags
- +19 ; refer to
- +20 ; DELETE("HARDSHIP") - if $G(DELETE("HARDSHIP"))=1 then the
- +21 ; segment will be created to delete the hardship.
- +22 ; DELETE("MT") - if $G(DELETE("MT"))=1 then
- +23 ; the segment will be created to delete a means test.
- +24 ; DELETE("RX")= if $G(DELETE("RX"))=1 then
- +25 ; the segment will be created to delete a pharmacy
- +26 ; copay test.
- +27 ; LIMIT - (optional) if $G(LIMIT)=1 then this indicates that a test in
- +28 ; a prior income year than indicated by the VAFMTDT parameter
- +29 ; should NOT be returned in the ZMT segment
- +30 ;
- +31 ; ****Also assumes all HL7 variables are defined as returned ****
- +32 ; by the INIT^HLTRANS call
- +33 ;
- +34 ; Output - string in the form of the DHCP HL7 ZMT segment
- +35 ;
- +36 ;
- +37 NEW NODE,PRIM,X,Y,VAFY,NODE2
- +38 ;
- +39 IF '$GET(DFN)!($GET(VAFSTR)']"")
- GOTO QUIT
- +40 SET $PIECE(VAFY,HLFS,22)=""
- SET VAFSTR=","_VAFSTR_","
- +41 SET VAFTYPE=$SELECT($GET(VAFTYPE):VAFTYPE,1:1)
- +42 SET VAFMTDT=$SELECT($GET(VAFMTDT):VAFMTDT,1:DT)
- +43 SET $PIECE(VAFY,HLFS,1)=$SELECT($GET(SETID):SETID,1:1)
- +44 SET (NODE,NODE2,PRIM)=""
- +45 ;
- +46 ;handle deletions of a test
- +47 IF ($GET(DELETE("MT"))=1)
- IF VAFTYPE=1
- Begin DoDot:1
- +48 ; MT Date
- SET $PIECE(VAFY,HLFS,2)=$$HLDATE^HLFNC(DELETE("DATE OF TEST"))
- +49 SET $PIECE(VAFY,HLFS,3)=HLQ
- +50 IF ($GET(DELETE("HARDSHIP"))=1)
- SET $PIECE(VAFY,HLFS,24)=HLQ
- +51 ; Type Of Test
- SET $PIECE(VAFY,HLFS,17)=VAFTYPE
- End DoDot:1
- GOTO QUIT
- +52 ;
- +53 IF ($GET(DELETE("RX"))=1)
- IF VAFTYPE=2
- Begin DoDot:1
- +54 ; MT Date
- SET $PIECE(VAFY,HLFS,2)=$$HLDATE^HLFNC(DELETE("DATE OF TEST"))
- +55 SET $PIECE(VAFY,HLFS,3)=HLQ
- +56 ; Type Of Test
- SET $PIECE(VAFY,HLFS,17)=VAFTYPE
- End DoDot:1
- GOTO QUIT
- +57 ;
- +58 SET X=$$LST^DGMTU(DFN,VAFMTDT,$SELECT($GET(VAFTYPE):VAFTYPE,1:1))
- +59 IF +X
- SET NODE=$GET(^DGMT(408.31,+X,0))
- SET PRIM=$GET(^("PRIM"))
- SET NODE2=$GET(^DGMT(408.31,+X,2))
- +60 ;
- +61 ;if $$LST^DGMTU returned the wrong income year than disregard it
- +62 IF ($GET(LIMIT)=1)
- IF $EXTRACT(VAFMTDT,1,3)'=$EXTRACT(+NODE,1,3)
- SET (NODE,NODE2,X,PRIM)=""
- +63 ;
- +64 ; MT Date
- IF VAFSTR[",2,"
- SET $PIECE(VAFY,HLFS,2)=$SELECT(+NODE:$$HLDATE^HLFNC(+NODE),1:HLQ)
- +65 ; MT Status
- IF VAFSTR[",3,"
- SET X=$PIECE($GET(^DG(408.32,+$PIECE(NODE,"^",3),0)),"^",2)
- SET $PIECE(VAFY,HLFS,3)=$SELECT(X]"":X,1:"")
- +66 ; Income
- IF VAFSTR[",4,"
- SET $PIECE(VAFY,HLFS,4)=$SELECT($PIECE(NODE,"^",4)]"":$PIECE(NODE,"^",4),1:HLQ)
- +67 ; Net Worth
- IF VAFSTR[",5,"
- SET $PIECE(VAFY,HLFS,5)=$SELECT($PIECE(NODE,"^",5)]"":$PIECE(NODE,"^",5),1:HLQ)
- +68 ; Adjudication Date/Time
- IF VAFSTR[",6,"
- SET $PIECE(VAFY,HLFS,6)=$SELECT($PIECE(NODE,"^",10):$$HLDATE^HLFNC($PIECE(NODE,"^",10)),1:HLQ)
- +69 ; Agreed To Pay
- IF VAFSTR[",7,"
- SET $PIECE(VAFY,HLFS,7)=$$YN^VAFHLFNC($PIECE(NODE,"^",11))
- +70 ; Threshold A
- IF VAFSTR[",8,"
- SET $PIECE(VAFY,HLFS,8)=$SELECT($PIECE(NODE,"^",12):$PIECE(NODE,"^",12),1:HLQ)
- +71 ; Deductible Expenses
- IF VAFSTR[",9,"
- SET $PIECE(VAFY,HLFS,9)=$SELECT($PIECE(NODE,"^",15)]"":$PIECE(NODE,"^",15),1:HLQ)
- +72 ; Date/Time Completed
- IF VAFSTR[",10,"
- SET $PIECE(VAFY,HLFS,10)=$SELECT($PIECE(NODE,"^",7):$$HLDATE^HLFNC($PIECE(NODE,"^",7)),1:HLQ)
- +73 ; Previous Year Means Test Threshold Flag
- IF VAFSTR[",11,"
- SET $PIECE(VAFY,HLFS,11)=$$YN^VAFHLFNC($PIECE(NODE,"^",16))
- +74 ; Total Dependents
- IF VAFSTR[",12,"
- SET $PIECE(VAFY,HLFS,12)=$SELECT($PIECE(NODE,"^",18)]"":$PIECE(NODE,"^",18),1:HLQ)
- +75 ; Hardship
- IF VAFSTR[",13,"
- SET $PIECE(VAFY,HLFS,13)=$$YN^VAFHLFNC($PIECE(NODE,"^",20))
- +76 ; Hardship Review Date
- IF VAFSTR[",14,"
- SET $PIECE(VAFY,HLFS,14)=$SELECT($PIECE(NODE,"^",21):$$HLDATE^HLFNC($PIECE(NODE,"^",21)),1:HLQ)
- +77 ; Date Vet Signed Test
- IF VAFSTR[",15,"
- SET $PIECE(VAFY,HLFS,15)=$SELECT($PIECE(NODE,"^",24):$$HLDATE^HLFNC($PIECE(NODE,"^",24)),1:HLQ)
- +78 ; Declines To Give Income Info
- IF VAFSTR[",16,"
- SET $PIECE(VAFY,HLFS,16)=$$YN^VAFHLFNC($PIECE(NODE,"^",14))
- +79 ; Type Of Test
- IF VAFSTR[",17,"
- SET $PIECE(VAFY,HLFS,17)=$SELECT($PIECE(NODE,"^",19):$PIECE(NODE,"^",19),1:VAFTYPE)
- +80 ; Source Of Test
- IF VAFSTR[",18,"
- SET $PIECE(VAFY,HLFS,18)=$SELECT($PIECE(NODE,"^",23)]"":$PIECE(NODE,"^",23),1:HLQ)
- +81 ; Primary Test?
- IF VAFSTR[",19,"
- SET $PIECE(VAFY,HLFS,19)=$$YN^VAFHLFNC(PRIM)
- +82 ; Date IVM Verified MT Completed
- IF VAFSTR[",20,"
- SET $PIECE(VAFY,HLFS,20)=$SELECT($PIECE(NODE,"^",25):$$HLDATE^HLFNC($PIECE(NODE,"^",25)),1:HLQ)
- +83 ; Refused To Sign
- IF VAFSTR[",21,"
- SET $PIECE(VAFY,HLFS,21)=$$YN^VAFHLFNC($PIECE(NODE,"^",26))
- +84 ;
- +85 ;
- +86 ;Site Conducting Test
- IF VAFSTR[",22,"
- SET $PIECE(VAFY,HLFS,22)=$PIECE(NODE2,"^",5)
- +87 ;Site Granting Hardship
- IF VAFSTR[",23,"
- SET $PIECE(VAFY,HLFS,23)=$PIECE(NODE2,"^",4)
- +88 ;Hardship Effective Date
- IF VAFSTR[",24,"
- SET $PIECE(VAFY,HLFS,24)=$SELECT($PIECE(NODE2,"^"):$$HLDATE^HLFNC($PIECE(NODE2,"^")),1:"")
- +89 ;Dt/Tm Test Last Edited
- IF VAFSTR[",25,"
- SET $PIECE(VAFY,HLFS,25)=$SELECT($PIECE(NODE2,"^",2):$$HLDATE^HLFNC($PIECE(NODE2,"^",2)),1:"")
- +90 ; Test Determined Status
- IF VAFSTR[",26,"
- SET $PIECE(VAFY,HLFS,26)=$SELECT($PIECE(NODE2,"^",3):$$GETCODE^DGMTH($PIECE(NODE2,"^",3)),1:"")
- +91 ;
- +92 ;can only transmit the deletion of a hardship if the segment is for a means test - and the income years must match if there is a means test
- +93 ;
- +94 IF VAFTYPE=1
- IF ($GET(DELETE("HARDSHIP"))=1)
- IF ('(+NODE)!($EXTRACT(DELETE("DATE OF TEST"),1,3)=$EXTRACT((+NODE),1,3)))
- SET $PIECE(VAFY,HLFS,24)=HLQ
- +95 ;
- QUIT QUIT "ZMT"_HLFS_$GET(VAFY)