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

BKMVSUP6.m

Go to the documentation of this file. 
  1. BKMVSUP6 ;PRXM/HC/WOM - Continuation of BKMVSUP, HIV SUPPLEMENT; [ 1/19/2005 7:16 PM ] ; 10 Jun 2005  12:31 PM
  1.  ;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
  1.  Q
  1.  W @IOF
  1.  ;I PAGE=1 S $X=0
  1.  ;E  W @IOF
  1.  W !?1,$$CONF(""),!?(IOM-41\2),"****** HMS PATIENT CARE SUPPLEMENT ******"
  1.  W !!?1,"Report Date: ",XNOW,?69,"Page: ",PAGE,!!
  1.  Q
  1.  ;
  1. PAUSE() ; EP - For screen displays pause and allow user to stop
  1.  ; Returns a 1 if the user elected to stop
  1.  ; Matches Health Summary
  1.  I IOST'["C-" Q 0
  1.  N READ
  1.  R !,"<>",READ:DTIME I '$T Q 1
  1.  I READ="^" Q 1
  1.  Q 0
  1.  ;
  1. CONF(END) ; EP - Print confidential message
  1.  ; END is set if final page and ending message is being printed.
  1.  N X,Y,TIM,AP,HDR
  1.  S Y=$$FMTE^XLFDT($$NOW^XLFDT()) S TIM=$P(Y,"@",2)
  1.  S AP="AM" S:+TIM=12 AP="PM"
  1.  S:+TIM>12 TIM=TIM-12_":"_$P(TIM,":",2),AP="PM" S TIM=TIM_" "_AP
  1.  ; ***** CONFIDENTIAL PATIENT INFORMATION --  DATE/TIME **************
  1.  S HDR="CONFIDENTIAL PATIENT INFORMATION -- "_$$FMTE^XLFDT(DT,"5Z")_" "_$J(TIM,9)_"  ["_$P(^VA(200,DUZ,0),U,2)_"]"
  1.  S X="",$P(X,"*",((IOM-6-$L(HDR))\2)+1)="*"
  1.  S HDR=$S($G(END):$E("**** END *",$L(X)-4,12),1:X)_" "_HDR_" "_X
  1.  Q HDR
  1.  ;
  1. GETALL(DFN) ; EP - Gather patient information
  1.  ; Code taken from BKMVC6 but revised to limit search to Problem List and to capture problem status
  1.  NEW IENDA0,IENDA,IENS,TARGET,HTARGET
  1.  NEW ATAX,ATAX1,STAT,OTHERDT,DATE,ICD9,POVDATE,REVDATE,VPOV
  1.  K ICD9S
  1.  S ATAX=$O(^ATXAX("B","BKMV AIDS DEF ILL DXS",""))   ; DX.1
  1.  S ATAX1=$O(^ATXAX("B","BKMV HIV OPP INF DXS",""))   ; DX.8
  1.  ;
  1.  S VPOV=""
  1.  F  S VPOV=$O(^AUPNPROB("AC",DFN,VPOV)) Q:VPOV=""  D
  1.  . S IENS=$$IENS^DILF(VPOV)
  1.  . S POVDATE=$$PROB^BKMVUTL(IENS)
  1.  . Q:POVDATE'?1.N
  1.  . S REVDATE=9999999-POVDATE
  1.  . S ICD9=$P($G(^AUPNPROB(VPOV,0)),"^",1)
  1.  . I ICD9="" Q
  1.  . I $$PATCH^XPDUTL("ATX*5.1*11") I $$ICD^ATXAPI(ICD9,ATAX,9)=0,$$ICD^ATXAPI(ICD9,ATAX1,9)=0 Q
  1.  . E  I $$ICD^BKMIXX5(ICD9,ATAX,9)=0,$$ICD^BKMIXX5(ICD9,ATAX1,9)=0 Q
  1.  . S NAR=$$GET1^DIQ(9000011,IENS,.05,"E")
  1.  . S STAT=$$GET1^DIQ(9000011,IENS,.12,"E")
  1.  . S DATE=REVDATE,OTHERDT="" ;ICD9S(REVDATE,ICD9)=STAT_U_NAR
  1.  . ;List date entered/last modified if different from date of onset
  1.  . I POVDATE'=$$GET1^DIQ(9000011,IENS,.13,"I") D
  1.  ..  ;N OTHERDT
  1.  ..  S OTHERDT=$$GET1^DIQ(9000011,IENS,.13,"I")
  1.  ..  ;I OTHERDT="" S OTHERDT=$$GET1^DIQ(9000011,IENS,.03,"I")
  1.  ..  Q:POVDATE=OTHERDT!(OTHERDT="")
  1.  ..  S DATE=9999999-OTHERDT
  1.  ..  ;S ICD9S(REVDATE,ICD9)=STAT_U_NAR_U_OTHERDT
  1.  . I OTHERDT=POVDATE S POVDATE=""
  1.  . S ICD9S(DATE,ICD9)=STAT_U_NAR_U_POVDATE
  1.  QUIT
  1.  ;
  1. LIPID(DFN) ; EP - Retrieve Lipid taxonomies
  1.  N LAST,GLOBAL
  1.  N CPTTAX,LOINTAX,SITETAX
  1.  S LINE=" Lipid Profile:"
  1.  ;D UPD^BKMVSUP
  1.  K BKMT("LIP"),BKMT("LIPID")
  1.  S GLOBAL="BKMT(""LIP"",VSTDT,TEST,""LAB"")"
  1.  S CPTTAX="BGP LIPID PROFILE CPTS"
  1.  S LOINTAX="BGP LIPID PROFILE LOINC CODES"
  1.  S SITETAX="DM AUDIT LIPID PROFILE TAX"
  1.  D LIPPRO(LOINTAX,DFN,"","",GLOBAL)
  1.  D LIPPRO(SITETAX,DFN,"","",GLOBAL)
  1.  D CPTTAX^BKMIXX(DFN,CPTTAX,"","",GLOBAL)
  1.  I $D(BKMT("LIP")) D  Q
  1.  . S LAST=$O(BKMT("LIP",""),-1)
  1.  . M BKMT("LIPID",LAST)=BKMT("LIP",LAST) K BKMT("LIP")
  1.  . D LTAXPRT^BKMVSUP1("LIPID",1000,1)
  1.  S GLOBAL="BKMT(""LIPID"",VSTDT,TEST,""LAB"")"
  1.  D REFUSAL^BKMIXX2(DFN,60,LOINTAX,"","",GLOBAL)
  1.  D REFUSAL^BKMIXX2(DFN,60,SITETAX,"","",GLOBAL)
  1.  ; Print results
  1.  D LTAXPRT^BKMVSUP1("LIPID",1,1,1)
  1.  I LINE'="" D UPD^BKMVSUP
  1.  Q
  1. LIPPRO(TAX,DFN,EDATE,SDATE,TARGET) ; EP
  1.  ; Get lab result associated with a lipid profile for a patient
  1.  ;
  1.  N RESULT,LAB,LB,IEN,TEST,VISIT,VSTDT
  1.  S RESULT=""
  1.  D BLDTAX^BKMIXX5(TAX,"LAB")
  1.  S LAB=""
  1.  F  S LAB=$O(LAB(LAB)) Q:LAB=""  D  ;I $O(^LAB(60,LAB,2)) D
  1.  . S IEN=0
  1.  . F  S IEN=$O(^LAB(60,LAB,2,IEN)) Q:'IEN  S LB=$G(^(IEN,0)) I LB'="" S LAB(LB)=""
  1.  S TEST="" ;,LDATE=$G(LDATE,""),LIEN=$G(LIEN,"")
  1.  F  S TEST=$O(^AUPNVLAB("AC",DFN,TEST),-1) Q:TEST=""  D
  1.  .S LAB=$$GET1^DIQ(9000010.09,TEST,.01,"I")
  1.  .I LAB="" Q
  1.  .I '$D(LAB(LAB)) Q
  1.  .S VISIT=$$GET1^DIQ(9000010.09,TEST,.03,"I")
  1.  .S VSTDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I") Q:VSTDT=""
  1.  .I $G(SDATE)'="",(VSTDT<SDATE) Q
  1.  .I $G(EDATE)'="",(VSTDT\1>EDATE) Q
  1.  .;I VSTDT>LDATE S LDATE=VSTDT,LIEN=TEST
  1.  .;I VSTDT=LDATE,TEST>LIEN S LDATE=VSTDT,LIEN=TEST
  1.  .S RESULT=$$GET1^DIQ(9000010.09,TEST,.04,"I")
  1.  .I $G(TARGET)]"" S @TARGET=RESULT
  1.  Q
  1.  ;
  1. HIVTAG(DFN) ;Retrieve HIV/AIDS Diagnostic Tag Information
  1.  N DCIEN,TAGIEN,TAG,TAGDT
  1.  S TAG=""
  1.  S DCIEN=$O(^BQI(90506.2,"B","HIV/AIDS",""))
  1.  I DCIEN'="" D
  1.  . S TAGIEN=$O(^BQIREG("C",DFN,DCIEN,""))
  1.  . I TAGIEN'="" D
  1.  .. S TAG=$$GET1^DIQ(90509,TAGIEN_",",.03,"E")
  1.  .. S TAG=$$LOWER^VALM1(TAG) ;Change to mixed case
  1.  .. S TAGDT=$$GET1^DIQ(90509,TAGIEN_",",.04,"I")
  1.  .. I TAGDT S TAG=TAG_"  "_$$FMTE^XLFDT(TAGDT\1,"5Z")
  1.  Q TAG
  1.  ;
  1. XIT ; QUIT POINT
  1.  Q