Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBDFN2

IBDFN2.m

Go to the documentation of this file. 
  1. IBDFN2 ;ALB/CJM - ENCOUNTER FORM - INTERFACE ROUTINES ;NOV 16,1992
  1.  ;;3.0;AUTOMATED INFO COLLECTION SYS;**29,31,36**;APR 24, 1997
  1. APPT ;returns appt date@time^date^time
  1.  N Y
  1.  S Y="" I IBAPPT S Y=IBAPPT K %DT D DD^%DT
  1.  S @IBARY=Y_"^"_$P(Y,"@")_"^"_$P(Y,"@",2)
  1.  Q
  1. NOW ;returns date and time
  1.  ;FORMATS:
  1.  ; MMM DD, YYYY@HH:MM:SS at the "IB DATE@TIME" subscript
  1.  ; MMM DD,YYYY at the "IB DATE" subscript
  1.  ; HH:MM:SS at the "IB TIME" subscript      
  1.  N Y,%,%H,%I,X
  1.  D NOW^%DTC S Y=% K %DT D DD^%DT
  1.  S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"IB CURRENT DATE@TIME")=Y
  1.  S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"IB CURRENT TIME")=$P(Y,"@",2)
  1.  S ^TMP("IB",$J,"INTERFACES",+$G(DFN),"IB CURRENT DATE")=$P(Y,"@")
  1.  Q
  1.  ;
  1. SPSEMPLR ;returns spouse's employer,address, telephone
  1.  ;input variables - DFN
  1.  N ARY,CNT S CNT=1
  1.  S ARY="^TMP(""IB"",$J,""INTERFACES"",+$G(DFN))"
  1.  S VAOA("A")=6 D OAD^VADPT
  1.  I VAERR S (@ARY@("DPT SPOUSE'S EMPLOYER NAME"),@ARY@("DPT SPOUSE'S EMPLOYER TELEPHONE"),@ARY@("DPT SPOUSE'S EMPLOYER ADDRESS LINES"))=""  Q
  1.  I VAOA(1)'="" S @ARY@("DPT SPOUSE'S EMPLOYER ADDRESS LINES",CNT)=VAOA(1),CNT=CNT+1
  1.  I VAOA(2)'="" S @ARY@("DPT SPOUSE'S EMPLOYER ADDRESS LINES",CNT)=VAOA(2),CNT=CNT+1
  1.  I VAOA(3)'="" S @ARY@("DPT SPOUSE'S EMPLOYER ADDRESS LINES",CNT)=VAOA(3),CNT=CNT+1
  1.  S @ARY@("DPT SPOUSE'S EMPLOYER ADDRESS LINES",CNT)=VAOA(4)_", "_$P(VAOA(5),"^",2)_" "_VAOA(6)
  1.  S @ARY@("DPT SPOUSE'S EMPLOYER TELEPHONE")=VAOA(8)
  1.  S @ARY@("DPT SPOUSE'S EMPLOYER NAME")=VAOA(9)
  1.  K VAOA,VAERR
  1.  Q
  1. EMPLOYER ;returns employer,address, telephone
  1.  ;input variables - DFN
  1.  N ARY,CNT S CNT=1
  1.  S ARY="^TMP(""IB"",$J,""INTERFACES"",DFN)"
  1.  S VAOA("A")=5 D OAD^VADPT
  1.  I VAERR S (@ARY@("DPT PATIENT'S EMPLOYER NAME"),@ARY@("DPT PATIENT'S EMPLOYER TELEPHONE"),@ARY@("DPT PATIENT'S EMPLOYER ADDRESS LINES"))=""  Q
  1.  I VAOA(1)'="" S @ARY@("DPT PATIENT'S EMPLOYER ADDRESS LINES",CNT)=VAOA(1),CNT=CNT+1
  1.  I VAOA(2)'="" S @ARY@("DPT PATIENT'S EMPLOYER ADDRESS LINES",CNT)=VAOA(2),CNT=CNT+1
  1.  I VAOA(3)'="" S @ARY@("DPT PATIENT'S EMPLOYER ADDRESS LINES",CNT)=VAOA(3),CNT=CNT+1
  1.  S @ARY@("DPT PATIENT'S EMPLOYER ADDRESS LINES",CNT)=VAOA(4)_", "_$P(VAOA(5),"^",2)_" "_VAOA(6)
  1.  S @ARY@("DPT PATIENT'S EMPLOYER TELEPHONE")=VAOA(8)
  1.  S @ARY@("DPT PATIENT'S EMPLOYER NAME")=VAOA(9)
  1.  K VAOA,VAERR
  1.  Q
  1. MT ;returns means test data
  1.  N Y,RET,GET
  1.  S GET=$$LST^DGMTU(DFN)
  1.  S RET=$P(GET,"^",3)_"^"
  1.  S Y=$P(GET,"^",2) D DD^%DT
  1.  S RET=RET_Y_"^"_$P(GET,"^",4)
  1.  S @IBARY=RET
  1.  Q
  1. 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)
  1.  N GMRA,GMRAL,NODE,I,COUNT,TYPE
  1.  D:$L($T(GMRADPT^GMRADPT)) ^GMRADPT
  1.  I GMRAL=0 S COUNT=1,@IBARY@(COUNT)="NKA" Q
  1.  S (COUNT,I)=0 F  S I=$O(GMRAL(I)) Q:'I  D
  1.  .S COUNT=COUNT+1
  1.  .S NODE=$G(GMRAL(I))
  1.  .S TYPE=$P(NODE,"^",3)
  1.  .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:"")
  1.  Q
  1.  ;
  1. PRMT ; -- print a 1010f if required or will expire in 357.09;.1 days
  1.  ;    called from print manger
  1.  ;    requires dfn, ibappt=appointment date
  1.  ;
  1.  N IBDMT,IBDMT1,IBDMT2,DGMTI,DGMTDT,DGMTYPT,DGOPT
  1.  S IBDMT1=$$LST^DGMTU(DFN,DT,1) ; means test
  1.  S IBDMT2=$$LST^DGMTU(DFN,DT,2) ; copay test
  1.  I IBDMT2="",IBDMT1="" G PRMTQ
  1.  S IBDMT=$S(IBDMT2="":IBDMT1,IBDMT1="":IBDMT2,$P(IBDMT1,"^",2)'<$P(IBDMT2,"^",2):IBDMT1,1:IBDMT2)
  1.  S DGMTYPT=$S(IBDMT=IBDMT2:2,1:1) ; set type of test
  1.  S DGMTI=+IBDMT,DGMTDT=$P(IBDMT,"^",2)
  1.  S DGOPT=1 ;pretend were from registration, don't close device when done
  1.  S STATUS=$P(IBDMT,"^",4)
  1.  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
  1.  ;
  1.  I STATUS="R" D GETMT I IBDMT1="" Q
  1.  D START^DGMTP
  1. PRMTQ Q
  1.  ;
  1. GETMT ;Since status is required find last valid means test
  1.  ;
  1.  S IBDMT=$$LVMT^DGMTU(DFN,DT) ; means test
  1.  S DGMTYPT=1 ; set type of test
  1.  S DGMTI=+IBDMT,DGMTDT=$P(IBDMT,"^",2)
  1.  Q
  1.  ;
  1.  ;
  1. MSTSTAT ;-- Get patient's MST status for EF display block
  1.  ;     Input: 
  1.  ;       DFN
  1.  ;
  1.  ;    Output: 
  1.  ;       Calls API $$GETSTAT^DGMSTAPI(DFN):
  1.  ;         Piece 1 -- MST Status Code (Y, N, D, or U)
  1.  ;         Piece 2 -- MST Status Description
  1.  ;
  1.  N ARY,MST
  1.  S ARY="^TMP(""IB"",$J,""INTERFACES"",DFN)"
  1.  I '$G(DFN) Q
  1.  S MST=$$GETSTAT^DGMSTAPI(DFN)
  1.  I +MST=0!(+MST>0) S @ARY@("DGMST STATUS")=$P(MST,"^",2)_"^"_$S(+MST>0:$P(MST,"^",6),1:"Unknown, not screened")
  1.  Q
  1.  ;
  1.  ;
  1. ASKMST ;-- Ask if patient's treatment is related to SC and MST (if applicable)
  1.  ;
  1.  N ARY,COUNT
  1.  Q:'$G(DFN)
  1.  S ARY="^TMP(""IB"",$J,""INTERFACES"")"
  1.  S COUNT=1
  1.  I $$SC^SDCO22(DFN,0) S @ARY@("DGMST SELECT MST CLASSIFICATN",COUNT)="SC^Was treatment for an SC condition?",COUNT=COUNT+1
  1.  I $$MST^SDCO22(DFN,0) S @ARY@("DGMST SELECT MST CLASSIFICATN",COUNT)="MST^Was treatment related to MST?  (Ask provider only)"
  1.  Q