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

BKMVA4.m

Go to the documentation of this file.
  1. BKMVA4 ;PRXM/HC/JGH - HMS PATIENT REGISTER; [ 1/19/2005 7:16 PM ] ; 09 Jun 2005 12:53 PM
  1. ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
  1. ;
  1. Q
  1. ;
  1. EN ;ENTRY POINT -- ListMan template BKMV PCC LAB UPDATE
  1. ; Called by Add New Data option for Lab
  1. ; Assumes existence of DFN,DUZ
  1. N HIVIEN
  1. S HIVIEN=$$HIVIEN^BKMIXX3()
  1. I HIVIEN="" W !,"There is no HMS register defined." H 2 Q
  1. I '$$VALID^BKMIXX3(DUZ) Q
  1. I '$$BKMPRIV^BKMIXX3(DUZ) D NOGO^BKMIXX3 Q
  1. K ^TMP("BKMVA4",$J)
  1. D ^XBFMK
  1. D EN^VALM("BKMV PCC LAB UPDATE")
  1. D ^XBFMK
  1. D EXIT
  1. Q
  1. ;
  1. HDR ; -- header code
  1. ; Assumes existence of DUZ
  1. N DA,IENS,SITE
  1. S DA=$G(DUZ(2)),IENS=$$IENS^DILF(.DA),SITE=$$GET1^DIQ(4,IENS,.01,"E")
  1. S VALMHDR(1)=$$PAD^BKMIXX4("",">"," ",(80-$L(SITE)+2)\2)_"["_$G(SITE)_"]"
  1. S VALMHDR(2)=$G(RCRDHDR)
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. ; Assumes existence of DFN
  1. D GETALL(DFN)
  1. Q
  1. ;
  1. GETALL(DFN) ; Build ListMan display array of patient lab information
  1. ; Input variables:
  1. ; DFN - IEN for File 2
  1. ; Output variables:
  1. ; VALMAR - Builds ListMan array
  1. ; VALMCNT - List array count
  1. ; VALM0
  1. N DA0,DA1,TEXT,LABDT,IENS,REFLOW,REFHIGH,BKMRNG,PLABDT
  1. D ^XBFMK
  1. S VALMCNT=0,VALMAR="^TMP(""BKMVA4"","""_$J_""")",VALM0=""
  1. S DA1=$O(^BKM(90459,"B",$J,""))
  1. Q:DA1=""
  1. S (LABDT,PLABDT)=""
  1. F S LABDT=$O(^BKM(90459,DA1,13,"B",LABDT),-1) Q:LABDT="" D
  1. . S DA0=""
  1. . F S DA0=$O(^BKM(90459,DA1,13,"B",LABDT,DA0)) Q:DA0="" D
  1. . . S DA(1)=DA1,DA=DA0
  1. . . S IENS=$$IENS^DILF(.DA)
  1. . . S VALMCNT=$G(VALMCNT)+1
  1. . . S TEXT=""
  1. . . S TEXT=$$SETFLD^VALM1($$PAD^BKMIXX4(VALMCNT,"<"," ",3)_".",TEXT,"Item")
  1. . . ;S TEXT=$$SETFLD^VALM1($$FMTE^XLFDT($$GET1^DIQ(90459.1313,IENS,".01","I"),"5Z"),TEXT,"Visit")
  1. . . ; Display only date when it does not equal the previous date
  1. . . S TEXT=$$SETFLD^VALM1($S((LABDT\1)'=(PLABDT\1):$$FMTE^XLFDT(LABDT\1,"5Z"),1:""),TEXT,"Visit")
  1. . . S TEXT=$$SETFLD^VALM1($$GET1^DIQ(90459.1313,IENS,".02","E"),TEXT,"Lab")
  1. . . S TEXT=$$SETFLD^VALM1($$GET1^DIQ(90459.1313,IENS,".03","E"),TEXT,"Result")
  1. . . S TEXT=$$SETFLD^VALM1($$GET1^DIQ(90459.1313,IENS,"1101","E"),TEXT,"Units")
  1. . . S REFLOW=$$GET1^DIQ(90459.1313,IENS,1104,"E")
  1. . . S REFHIGH=$$GET1^DIQ(90459.1313,IENS,1105,"E")
  1. . . S BKMRNG=REFLOW_"-"_REFHIGH
  1. . . I BKMRNG="-" S BKMRNG=""
  1. . . S TEXT=$$SETFLD^VALM1(BKMRNG,TEXT,"RefRange")
  1. . . D SET^VALM10(VALMCNT,TEXT,DA0)
  1. . . S PLABDT=LABDT
  1. D ^XBFMK
  1. Q
  1. ;
  1. ADD ; Add entry to File 90459
  1. D FULL^VALM1
  1. N DA,DA1,DA0,DIC,Y,DIE,DR,BKMDTM,IENS,BKMLAB,DIK,BKMDOD
  1. S (DA(1),DA1)=$O(^BKM(90459,"B",$J,""))
  1. Q:DA(1)=""
  1. ; Default to today's date for prompt, except for deceased patients
  1. ;S X=$$NOW^XLFDT()
  1. S X=$$DT^XLFDT()
  1. S BKMDOD=$$GET1^DIQ(2,DFN,".351","I")
  1. I BKMDOD'="" S X=$$FMADD^XLFDT(BKMDOD,-1)
  1. S DIC="^BKM(90459,"_DA(1)_",13,"
  1. S DIC(0)="L"
  1. ; Add new entry
  1. K DO
  1. D FILE^DICN
  1. I Y=-1 G ADDX
  1. S DA0=+Y
  1. ADD1 ; Edit Exam fields in subfile
  1. S DIE="^BKM(90459,"_DA1_",13,"
  1. ; Internal entry number of subentry chosen
  1. S DA=DA0,DA(1)=DA1
  1. S DR=".02;.01;.03;1101;1104;1105"
  1. D ^DIE
  1. K DA
  1. S DA=DA0,DA(1)=DA1,IENS=$$IENS^DILF(.DA)
  1. S BKMDTM=$$GET1^DIQ(90459.1313,IENS,".01","I")
  1. S BKMLAB=$$GET1^DIQ(90459.1313,IENS,".02","I")
  1. I BKMDTM=""!(BKMLAB="") D G ADDX
  1. . K DA
  1. . S DA=DA0,DA(1)=DA1
  1. . S DIK="^BKM(90459,"_DA(1)_",13,"
  1. . D ^DIK
  1. . W " *** Required field(s) missing, entry deleted! ***" H 1
  1. I $P(BKMDTM,".")#100=0!(BKMDTM=(BKMDTM\1)) D
  1. . ; Default to first day of month, if date is imprecise
  1. . I $P(BKMDTM,".")#100=0 D
  1. . . S BKMDTM=$S($L(BKMDTM,".")=2:($P(BKMDTM,".")+1)_"."_$P(BKMDTM,".",2),1:$P(BKMDTM,".")+1)
  1. . ; Default time to noon, if not included, unless it is in the future
  1. . I BKMDTM=(BKMDTM\1) D
  1. . . S BKMDTM=BKMDTM_".1200"
  1. . . I BKMDTM>$$NOW^XLFDT() S BKMDTM=$$NOW^XLFDT()
  1. . S DR=".01///"_BKMDTM
  1. . D ^DIE
  1. ;
  1. ADDX ; Add entry exit point
  1. K ^TMP("BKMVA4",$J)
  1. D INIT
  1. Q
  1. ;
  1. EDIT ; Edit File 90459
  1. I +$G(VALMCNT)=0 D EN^DDIOL("No items to select") H 2 Q
  1. D FULL^VALM1
  1. N BKMLST,BKMI,VALMI,VALMAT,DA,DIE,DR,BKMDTM
  1. S BKMLST=$$SELECT^BKMVD2()
  1. I BKMLST'="" D
  1. . F BKMI=1:1:$L(BKMLST,",") S VALMI=$P(BKMLST,",",BKMI) Q:'VALMI D
  1. . . S VALMAT=$O(@VALMAR@("IDX",VALMI,""))
  1. . . Q:VALMAT=""
  1. . . S DA(1)=$O(^BKM(90459,"B",$J,""))
  1. . . Q:DA(1)=""
  1. . . S DA=VALMAT
  1. . . S DIE="^BKM(90459,"_DA(1)_",13,"
  1. . . S DR=".02;.01;.03;1101;1104;1105"
  1. . . D ^DIE
  1. . . ; If user deleted .01 field, DA is killed so quit this iteration
  1. . . I '$D(DA) Q
  1. . . S BKMDTM=$$GET1^DIQ(90459.1313,DA_","_DA(1)_",",.01,"I")
  1. . . I $P(BKMDTM,".")#100=0!(BKMDTM=(BKMDTM\1)) D
  1. . . . ; Default to first day of month, if date is imprecise
  1. . . . I $P(BKMDTM,".")#100=0 D
  1. . . . . S BKMDTM=$S($L(BKMDTM,".")=2:($P(BKMDTM,".")+1)_"."_$P(BKMDTM,".",2),1:$P(BKMDTM,".")+1)
  1. . . . ; Default time to noon, if not included, unless it is in the future
  1. . . . I BKMDTM=(BKMDTM\1) D
  1. . . . . S BKMDTM=BKMDTM_".1200"
  1. . . . . I BKMDTM>$$NOW^XLFDT() S BKMDTM=$$NOW^XLFDT()
  1. . . . S DR=".01///"_BKMDTM
  1. . . . D ^DIE
  1. . . W " Edited!" H 2
  1. K ^TMP("BKMVA4",$J)
  1. D INIT
  1. Q
  1. ;
  1. DELETE ; Delete entry in File 90459
  1. I +$G(VALMCNT)=0 D EN^DDIOL("No items to select") H 2 Q
  1. D FULL^VALM1
  1. N BKMLST,BKMI,VALMI,VALMAT,DA,DIK
  1. S BKMLST=$$SELECT^BKMVD2()
  1. I BKMLST'="" D
  1. . F BKMI=1:1:$L(BKMLST,",") S VALMI=$P(BKMLST,",",BKMI) Q:'VALMI D
  1. . . S VALMAT=$O(@VALMAR@("IDX",VALMI,""))
  1. . . Q:VALMAT=""
  1. . . ; Confirm deletion
  1. . . I '$$YNP^BKMVD2("Confirm deletion of Item "_VALMI,"NO") Q
  1. . . S DA(1)=$O(^BKM(90459,"B",$J,""))
  1. . . Q:DA(1)=""
  1. . . S DA=VALMAT
  1. . . S DIK="^BKM(90459,"_DA(1)_",13,"
  1. . . D ^DIK
  1. . . W " Deleted!" H 2
  1. K ^TMP("BKMVA4",$J)
  1. D INIT
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !
  1. Q
  1. ;
  1. LABTST ; EP - Input Transform for the Lab Test Value
  1. ; Exclude panels
  1. I $O(^LAB(60,X,2,0))'="" K X Q
  1. Q
  1. ;
  1. EXIT ;clean up used variables
  1. K ^TMP("BKMVA4",$J)
  1. K VALM0,VALMAR,VALMHDR,VALMCNT
  1. Q
  1. ;
  1. ;