IBDFN2 ;ALB/CJM - ENCOUNTER FORM - INTERFACE ROUTINES ;NOV 16,1992
;;3.0;AUTOMATED INFO COLLECTION SYS;**29,31,36,43**;APR 24, 1997
APPT ;returns appt date@time^date^time
N Y
S Y="" I IBAPPT S Y=IBAPPT K %DT D DD^%DT
S @IBARY=Y_"^"_$P(Y,"@")_"^"_$P(Y,"@",2)
Q
NOW ;returns date and time
;FORMATS:
; MMM DD, YYYY@HH:MM:SS at the "IB DATE@TIME" subscript
; MMM DD,YYYY at the "IB DATE" subscript
; HH:MM:SS at the "IB TIME" subscript
N Y,%,%H,%I,X
D NOW^%DTC S Y=% K %DT D DD^%DT
S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"IB CURRENT DATE@TIME")=Y
S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"IB CURRENT TIME")=$P(Y,"@",2)
S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"IB CURRENT DATE")=$P(Y,"@")
Q
;
SPSEMPLR ;returns spouse's employer,address, telephone
;input variables - DFN
N ARY,CNT S CNT=1
S ARY="^TMP(""IB"",$J,""INTERFACES"",+$G(DFN))"
S VAOA("A")=6 D OAD^VADPT
I VAERR S (@ARY@("DPT SPOUSE'S EMPLOYER NAME"),@ARY@("DPT SPOUSE'S EMPLOYER TELEPHONE"),@ARY@("DPT SPOUSE'S EMPLOYER ADDRESS LINES"))="" Q
I VAOA(1)'="" S @ARY@("DPT SPOUSE'S EMPLOYER ADDRESS LINES",CNT)=VAOA(1),CNT=CNT+1
I VAOA(2)'="" S @ARY@("DPT SPOUSE'S EMPLOYER ADDRESS LINES",CNT)=VAOA(2),CNT=CNT+1
I VAOA(3)'="" S @ARY@("DPT SPOUSE'S EMPLOYER ADDRESS LINES",CNT)=VAOA(3),CNT=CNT+1
S @ARY@("DPT SPOUSE'S EMPLOYER ADDRESS LINES",CNT)=VAOA(4)_", "_$P(VAOA(5),"^",2)_" "_VAOA(6)
S @ARY@("DPT SPOUSE'S EMPLOYER TELEPHONE")=VAOA(8)
S @ARY@("DPT SPOUSE'S EMPLOYER NAME")=VAOA(9)
K VAOA,VAERR
Q
EMPLOYER ;returns employer,address, telephone
;input variables - DFN
N ARY,CNT S CNT=1
S ARY="^TMP(""IB"",$J,""INTERFACES"",DFN)"
S VAOA("A")=5 D OAD^VADPT
I VAERR S (@ARY@("DPT PATIENT'S EMPLOYER NAME"),@ARY@("DPT PATIENT'S EMPLOYER TELEPHONE"),@ARY@("DPT PATIENT'S EMPLOYER ADDRESS LINES"))="" Q
I VAOA(1)'="" S @ARY@("DPT PATIENT'S EMPLOYER ADDRESS LINES",CNT)=VAOA(1),CNT=CNT+1
I VAOA(2)'="" S @ARY@("DPT PATIENT'S EMPLOYER ADDRESS LINES",CNT)=VAOA(2),CNT=CNT+1
I VAOA(3)'="" S @ARY@("DPT PATIENT'S EMPLOYER ADDRESS LINES",CNT)=VAOA(3),CNT=CNT+1
S @ARY@("DPT PATIENT'S EMPLOYER ADDRESS LINES",CNT)=VAOA(4)_", "_$P(VAOA(5),"^",2)_" "_VAOA(6)
S @ARY@("DPT PATIENT'S EMPLOYER TELEPHONE")=VAOA(8)
S @ARY@("DPT PATIENT'S EMPLOYER NAME")=VAOA(9)
K VAOA,VAERR
Q
MT ;returns means test data
N Y,RET,GET
S GET=$$LST^DGMTU(DFN)
S RET=$P(GET,"^",3)_"^"
S Y=$P(GET,"^",2) D DD^%DT
S RET=RET_Y_"^"_$P(GET,"^",4)
S @IBARY=RET
Q
ENROLL ;returns enrollment priority code and copay information
;
N IBEP,IBEP1
; --get enrollment priority code
S IBEP=$$PRIORITY^DGENA(DFN)
;
; --get copay information (yes or not)
S IBEP1=$$BIL^DGMTUB(DFN,DT)
S $P(IBEP,"^",2)=$S(IBEP1=1:"Y",1:"N")
S @IBARY=IBEP
Q
ALLERGY ;outputs a list of the patient's allergies
;piece #1=allergy name,#2=type of allergy(FOOD/DRUG/OTHER),#3=type of allergy(F/D/O),#4=VERFIED?(YES/NO),#5=TRUE ALLERGEN(YES/NO)
N GMRA,GMRAL,NODE,I,COUNT,TYPE
D:$L($T(GMRADPT^GMRADPT)) ^GMRADPT
I GMRAL=0 S COUNT=1,@IBARY@(COUNT)="NKA" Q
S (COUNT,I)=0 F S I=$O(GMRAL(I)) Q:'I D
.S COUNT=COUNT+1
.S NODE=$G(GMRAL(I))
.S TYPE=$P(NODE,"^",3)
.S @IBARY@(COUNT)=$P(NODE,"^",2)_"^"_$S(TYPE="D":"DRUG",TYPE="F":"FOOD",TYPE="O":"OTHER",1:"")_"^"_TYPE_"^"_$S($P(NODE,"^",4)=1:"YES",1:"NO")_"^"_$S($P(NODE,"^",5)=0:"YES",$P(NODE,"^",5)=1:"NO",1:"")
Q
;
PRMT ; -- print a 1010f if required or will expire in 357.09;.1 days
; called from print manger
; requires dfn, ibappt=appointment date
;
N IBDMT,IBDMT1,IBDMT2,DGMTI,DGMTDT,DGMTYPT,DGOPT
S IBDMT1=$$LST^DGMTU(DFN,DT,1) ; means test
S IBDMT2=$$LST^DGMTU(DFN,DT,2) ; copay test
I IBDMT2="",IBDMT1="" G PRMTQ
S IBDMT=$S(IBDMT2="":IBDMT1,IBDMT1="":IBDMT2,$P(IBDMT1,"^",2)'<$P(IBDMT2,"^",2):IBDMT1,1:IBDMT2)
S DGMTYPT=$S(IBDMT=IBDMT2:2,1:1) ; set type of test
S DGMTI=+IBDMT,DGMTDT=$P(IBDMT,"^",2)
S DGOPT=1 ;pretend were from registration, don't close device when done
S STATUS=$P(IBDMT,"^",4)
I $S(STATUS="R":0,STATUS="N":1,STATUS="L":1,STATUS="I":0,$$FMDIFF^XLFDT(IBAPPT,DGMTDT,1)>(365-$S($P($G(^IBD(357.09,1,0)),"^",10):$P(^(0),"^",10),1:30)):0,1:1) G PRMTQ ;not required within params
;
I STATUS="R" D GETMT I IBDMT1="" Q
D START^DGMTP
PRMTQ Q
;
GETMT ;Since status is required find last valid means test
;
S IBDMT=$$LVMT^DGMTU(DFN,DT) ; means test
S DGMTYPT=1 ; set type of test
S DGMTI=+IBDMT,DGMTDT=$P(IBDMT,"^",2)
Q
;
;
MSTSTAT ;-- Get patient's MST status for EF display block
; Input:
; DFN
;
; Output:
; Calls API $$GETSTAT^DGMSTAPI(DFN):
; Piece 1 -- MST Status Code (Y, N, D, or U)
; Piece 2 -- MST Status Description
;
N ARY,MST
S ARY="^TMP(""IB"",$J,""INTERFACES"",DFN)"
I '$G(DFN) Q
S MST=$$GETSTAT^DGMSTAPI(DFN)
I +MST=0!(+MST>0) S @ARY@("DGMST STATUS")=$P(MST,"^",2)_"^"_$S(+MST>0:$P(MST,"^",6),1:"Unknown, not screened")
Q
;
;
ASKMST ;-- Ask if patient's treatment is related to SC and MST (if applicable)
;
N ARY,COUNT
Q:'$G(DFN)
S ARY="^TMP(""IB"",$J,""INTERFACES"")"
S COUNT=1
I $$SC^SDCO22(DFN,0) S @ARY@("DGMST SELECT MST CLASSIFICATN",COUNT)="SC^Was treatment for an SC condition?",COUNT=COUNT+1
I $$MST^SDCO22(DFN,0) S @ARY@("DGMST SELECT MST CLASSIFICATN",COUNT)="MST^Was treatment related to MST? (Ask provider only)"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFN2 5368 printed Apr 09, 2024@21:50:10 Page 2
IBDFN2 ;ALB/CJM - ENCOUNTER FORM - INTERFACE ROUTINES ;NOV 16,1992
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**29,31,36,43**;APR 24, 1997
APPT ;returns appt date@time^date^time
+1 NEW Y
+2 SET Y=""
IF IBAPPT
SET Y=IBAPPT
KILL %DT
DO DD^%DT
+3 SET @IBARY=Y_"^"_$PIECE(Y,"@")_"^"_$PIECE(Y,"@",2)
+4 QUIT
NOW ;returns date and time
+1 ;FORMATS:
+2 ; MMM DD, YYYY@HH:MM:SS at the "IB DATE@TIME" subscript
+3 ; MMM DD,YYYY at the "IB DATE" subscript
+4 ; HH:MM:SS at the "IB TIME" subscript
+5 NEW Y,%,%H,%I,X
+6 DO NOW^%DTC
SET Y=%
KILL %DT
DO DD^%DT
+7 SET ^TMP("IB",$JOB,"INTERFACES",+$GET(DFN),"IB CURRENT DATE@TIME")=Y
+8 SET ^TMP("IB",$JOB,"INTERFACES",+$GET(DFN),"IB CURRENT TIME")=$PIECE(Y,"@",2)
+9 SET ^TMP("IB",$JOB,"INTERFACES",+$GET(DFN),"IB CURRENT DATE")=$PIECE(Y,"@")
+10 QUIT
+11 ;
SPSEMPLR ;returns spouse's employer,address, telephone
+1 ;input variables - DFN
+2 NEW ARY,CNT
SET CNT=1
+3 SET ARY="^TMP(""IB"",$J,""INTERFACES"",+$G(DFN))"
+4 SET VAOA("A")=6
DO OAD^VADPT
+5 IF VAERR
SET (@ARY@("DPT SPOUSE'S EMPLOYER NAME"),@ARY@("DPT SPOUSE'S EMPLOYER TELEPHONE"),@ARY@("DPT SPOUSE'S EMPLOYER ADDRESS LINES"))=""
QUIT
+6 IF VAOA(1)'=""
SET @ARY@("DPT SPOUSE'S EMPLOYER ADDRESS LINES",CNT)=VAOA(1)
SET CNT=CNT+1
+7 IF VAOA(2)'=""
SET @ARY@("DPT SPOUSE'S EMPLOYER ADDRESS LINES",CNT)=VAOA(2)
SET CNT=CNT+1
+8 IF VAOA(3)'=""
SET @ARY@("DPT SPOUSE'S EMPLOYER ADDRESS LINES",CNT)=VAOA(3)
SET CNT=CNT+1
+9 SET @ARY@("DPT SPOUSE'S EMPLOYER ADDRESS LINES",CNT)=VAOA(4)_", "_$PIECE(VAOA(5),"^",2)_" "_VAOA(6)
+10 SET @ARY@("DPT SPOUSE'S EMPLOYER TELEPHONE")=VAOA(8)
+11 SET @ARY@("DPT SPOUSE'S EMPLOYER NAME")=VAOA(9)
+12 KILL VAOA,VAERR
+13 QUIT
EMPLOYER ;returns employer,address, telephone
+1 ;input variables - DFN
+2 NEW ARY,CNT
SET CNT=1
+3 SET ARY="^TMP(""IB"",$J,""INTERFACES"",DFN)"
+4 SET VAOA("A")=5
DO OAD^VADPT
+5 IF VAERR
SET (@ARY@("DPT PATIENT'S EMPLOYER NAME"),@ARY@("DPT PATIENT'S EMPLOYER TELEPHONE"),@ARY@("DPT PATIENT'S EMPLOYER ADDRESS LINES"))=""
QUIT
+6 IF VAOA(1)'=""
SET @ARY@("DPT PATIENT'S EMPLOYER ADDRESS LINES",CNT)=VAOA(1)
SET CNT=CNT+1
+7 IF VAOA(2)'=""
SET @ARY@("DPT PATIENT'S EMPLOYER ADDRESS LINES",CNT)=VAOA(2)
SET CNT=CNT+1
+8 IF VAOA(3)'=""
SET @ARY@("DPT PATIENT'S EMPLOYER ADDRESS LINES",CNT)=VAOA(3)
SET CNT=CNT+1
+9 SET @ARY@("DPT PATIENT'S EMPLOYER ADDRESS LINES",CNT)=VAOA(4)_", "_$PIECE(VAOA(5),"^",2)_" "_VAOA(6)
+10 SET @ARY@("DPT PATIENT'S EMPLOYER TELEPHONE")=VAOA(8)
+11 SET @ARY@("DPT PATIENT'S EMPLOYER NAME")=VAOA(9)
+12 KILL VAOA,VAERR
+13 QUIT
MT ;returns means test data
+1 NEW Y,RET,GET
+2 SET GET=$$LST^DGMTU(DFN)
+3 SET RET=$PIECE(GET,"^",3)_"^"
+4 SET Y=$PIECE(GET,"^",2)
DO DD^%DT
+5 SET RET=RET_Y_"^"_$PIECE(GET,"^",4)
+6 SET @IBARY=RET
+7 QUIT
ENROLL ;returns enrollment priority code and copay information
+1 ;
+2 NEW IBEP,IBEP1
+3 ; --get enrollment priority code
+4 SET IBEP=$$PRIORITY^DGENA(DFN)
+5 ;
+6 ; --get copay information (yes or not)
+7 SET IBEP1=$$BIL^DGMTUB(DFN,DT)
+8 SET $PIECE(IBEP,"^",2)=$SELECT(IBEP1=1:"Y",1:"N")
+9 SET @IBARY=IBEP
+10 QUIT
ALLERGY ;outputs a list of the patient's allergies
+1 ;piece #1=allergy name,#2=type of allergy(FOOD/DRUG/OTHER),#3=type of allergy(F/D/O),#4=VERFIED?(YES/NO),#5=TRUE ALLERGEN(YES/NO)
+2 NEW GMRA,GMRAL,NODE,I,COUNT,TYPE
+3 if $LENGTH($TEXT(GMRADPT^GMRADPT))
DO ^GMRADPT
+4 IF GMRAL=0
SET COUNT=1
SET @IBARY@(COUNT)="NKA"
QUIT
+5 SET (COUNT,I)=0
FOR
SET I=$ORDER(GMRAL(I))
if 'I
QUIT
Begin DoDot:1
+6 SET COUNT=COUNT+1
+7 SET NODE=$GET(GMRAL(I))
+8 SET TYPE=$PIECE(NODE,"^",3)
+9 SET @IBARY@(COUNT)=$PIECE(NODE,"^",2)_"^"_$SELECT(TYPE="D":"DRUG",TYPE="F":"FOOD",TYPE="O":"OTHER",1:"")_"^"_TYPE_"^"_$SELECT($PIECE(NODE,"^",4)=1:"YES",1:"NO")_"^"_$SELECT($PIECE(NODE,"^",5)=0:"YES",$PIECE(NODE,"^",5)=1:"NO",1:"")
End DoDot:1
+10 QUIT
+11 ;
PRMT ; -- print a 1010f if required or will expire in 357.09;.1 days
+1 ; called from print manger
+2 ; requires dfn, ibappt=appointment date
+3 ;
+4 NEW IBDMT,IBDMT1,IBDMT2,DGMTI,DGMTDT,DGMTYPT,DGOPT
+5 ; means test
SET IBDMT1=$$LST^DGMTU(DFN,DT,1)
+6 ; copay test
SET IBDMT2=$$LST^DGMTU(DFN,DT,2)
+7 IF IBDMT2=""
IF IBDMT1=""
GOTO PRMTQ
+8 SET IBDMT=$SELECT(IBDMT2="":IBDMT1,IBDMT1="":IBDMT2,$PIECE(IBDMT1,"^",2)'<$PIECE(IBDMT2,"^",2):IBDMT1,1:IBDMT2)
+9 ; set type of test
SET DGMTYPT=$SELECT(IBDMT=IBDMT2:2,1:1)
+10 SET DGMTI=+IBDMT
SET DGMTDT=$PIECE(IBDMT,"^",2)
+11 ;pretend were from registration, don't close device when done
SET DGOPT=1
+12 SET STATUS=$PIECE(IBDMT,"^",4)
+13 ;not required within params
IF $SELECT(STATUS="R":0,STATUS="N":1,STATUS="L":1,STATUS="I":0,$$FMDIFF^XLFDT(IBAPPT,DGMTDT,1)>(365-$SELECT($PIECE($GET(^IBD(357.09,1,0)),"^",10):$PIECE(^(0),"^",10),1:30)):0,1:1)
GOTO PRMTQ
+14 ;
+15 IF STATUS="R"
DO GETMT
IF IBDMT1=""
QUIT
+16 DO START^DGMTP
PRMTQ QUIT
+1 ;
GETMT ;Since status is required find last valid means test
+1 ;
+2 ; means test
SET IBDMT=$$LVMT^DGMTU(DFN,DT)
+3 ; set type of test
SET DGMTYPT=1
+4 SET DGMTI=+IBDMT
SET DGMTDT=$PIECE(IBDMT,"^",2)
+5 QUIT
+6 ;
+7 ;
MSTSTAT ;-- Get patient's MST status for EF display block
+1 ; Input:
+2 ; DFN
+3 ;
+4 ; Output:
+5 ; Calls API $$GETSTAT^DGMSTAPI(DFN):
+6 ; Piece 1 -- MST Status Code (Y, N, D, or U)
+7 ; Piece 2 -- MST Status Description
+8 ;
+9 NEW ARY,MST
+10 SET ARY="^TMP(""IB"",$J,""INTERFACES"",DFN)"
+11 IF '$GET(DFN)
QUIT
+12 SET MST=$$GETSTAT^DGMSTAPI(DFN)
+13 IF +MST=0!(+MST>0)
SET @ARY@("DGMST STATUS")=$PIECE(MST,"^",2)_"^"_$SELECT(+MST>0:$PIECE(MST,"^",6),1:"Unknown, not screened")
+14 QUIT
+15 ;
+16 ;
ASKMST ;-- Ask if patient's treatment is related to SC and MST (if applicable)
+1 ;
+2 NEW ARY,COUNT
+3 if '$GET(DFN)
QUIT
+4 SET ARY="^TMP(""IB"",$J,""INTERFACES"")"
+5 SET COUNT=1
+6 IF $$SC^SDCO22(DFN,0)
SET @ARY@("DGMST SELECT MST CLASSIFICATN",COUNT)="SC^Was treatment for an SC condition?"
SET COUNT=COUNT+1
+7 IF $$MST^SDCO22(DFN,0)
SET @ARY@("DGMST SELECT MST CLASSIFICATN",COUNT)="MST^Was treatment related to MST? (Ask provider only)"
+8 QUIT
