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

WVLABADD.m

Go to the documentation of this file. 
  1. WVLABADD ;HCIOFO/FT - SAVE A LAB TEST AS A WH PROCEDURE ;07/28/2017  11:27
  1.  ;;1.0;WOMEN'S HEALTH;**6,24**;Sep 30, 1998;Build 582
  1.  ;
  1. EN ; Entry point from [WV SAVE LAB TEST] option.
  1.  ; Converts a lab test stored in the WV LAB TESTS file (#790.08) 
  1.  ; into an entry in the WV PROCEDURES file (#790.1)
  1.  N WVDICB
  1.  S (WVDICB,WVPOP)=0
  1.  F  D  Q:WVPOP
  1.  .D SELECT Q:WVPOP
  1.  .D DISPLAY
  1.  .Q
  1.  D KILL
  1.  Q
  1. SELECT ; Select a lab test entry from File 790.08
  1.  N DIC,DTOUT,DUOUT,WVDFN
  1.  S DIC="^WV(790.08,",DIC(0)="AEMQZ"
  1.  S DIC("A")="Select Lab Test Accession#: "
  1.  D DEFAULT
  1.  D ^DIC
  1.  I Y<0!($D(DTOUT))!($D(DUOUT)) S WVPOP=1 Q
  1.  S WVIEN=+Y
  1.  S WVDFN=+$P(^WV(790.08,+Y,0),U,2)
  1.  S:WVDFN ^DISV(DUZ,"^DPT(")=WVDFN ;space bar/return save for File 790
  1.  Q
  1. DISPLAY ; Display lab test data
  1.  Q:'$G(WVIEN)
  1.  N LRDFN,LRSS,WVDATE,WVLABACC,WVNAME,WVNODE,WVVALUE
  1.  S WVNODE=$G(^WV(790.08,+WVIEN,0))
  1.  Q:WVNODE=""
  1.  S WVLABACC=$P(WVNODE,U,1) ;lab accession#
  1.  S LRDFN=$P(WVNODE,U,36) ;File 63 ien (+^DPT(DFN,"LR"))
  1.  S WVDATE=$P(WVNODE,U,37) ;File 63 inverse date/time
  1.  S LRSS=$P(WVNODE,U,38) ;File 63 subscript (CY or SP)
  1.  I WVLABACC=""!(LRDFN="")!(WVDATE="")!(LRSS="") D  Q
  1.  .W !,"Sorry, lab test "_WVLABACC_" is not available after all."
  1.  .W !,"Will delete this lab test from the list of choices.",!
  1.  .D DELETE(WVIEN)
  1.  .Q
  1.  I $D(^WV(790.1,"F",WVLABACC)) D  Q
  1.  .S WVVALUE=$O(^WV(790.1,"F",WVLABACC,0))
  1.  .S WVVALUE=$P($G(^WV(790.1,WVVALUE,0)),U,1)
  1.  .W !,"Sorry, lab test "_WVLABACC_" is already saved as a procedure."
  1.  .W !,"It is logged as WH accession# "_WVVALUE_"."
  1.  .W !,"Will delete this lab test from the list of choices.",!
  1.  .D DELETE(WVIEN)
  1.  .Q
  1.  K ^TMP("WVLAB",$J)
  1.  D HS^WVLABWP ;call Health Summary, returns lab data in ^TMP("WVLAB",$J) 
  1.  I '$D(^TMP("WVLAB",$J)) D  Q
  1.  .W !,"Sorry, lab test data is not available for this choice."
  1.  .W !,"Will delete this lab test from the list of choices.",!
  1.  .D DELETE(WVIEN)
  1.  .Q
  1.  S WVNAME=$P(WVNODE,U,2) ;dfn
  1.  S WVNAME=$$GET1^DIQ(2,WVNAME,.01,"E") ;get patient name for Browser call
  1.  D BROWSE^DDBR("^TMP(""WVLAB"",$J)","N",WVNAME)
  1. KEEP ; Save lab test as procedure OR delete lab test from File 790.08 OR
  1.  ; ignore it for now.
  1.  N DIR
  1.  S DIR(0)="S^A:add to the WH package;D:delete from the list of choices;I:ignore for now"
  1.  S DIR("A")="What action should be taken with this lab test"
  1.  S DIR("?",1)="Please determine what to do with this lab test."
  1.  S DIR("?",2)="  Ignore this lab test for now."
  1.  S DIR("?",3)="  Delete from the list. It shouldn't be a Women's Health procedure."
  1.  S DIR("?")="  Add this lab test as a Women's Health procedure entry."
  1.  D ^DIR
  1.  I $D(DIRUT) S WVPOP=1 Q
  1.  I Y="I" Q
  1.  I Y="D" D DELETE(WVIEN) Q
  1.  I Y="A" D CONVERT
  1.  Q
  1. CONVERT ; Add the lab test data to the WV PROCEDURE file (#790.1)
  1.  Q:'$G(WVIEN)
  1.  N DFN,DIC,DTOUT,DUOUT
  1.  N WVDATE,WVDR,WVERR,WVNODE,WVPROC
  1.  S WVNODE=$G(^WV(790.08,+WVIEN,0))
  1.  S DIC="^WV(790.2,",DIC(0)="AEMQZ"
  1.  S DIC("A")="Select the procedure type for this lab test: "
  1.  D ^DIC
  1.  W !
  1.  I Y<0!($D(DTOUT))!($D(DUOUT)) S WVPOP=1 Q
  1.  S WVPROC=+Y
  1.  S WVERR=1,DFN=$P(WVNODE,U,2),WVDATE=$P(WVNODE,U,12)
  1.  I '$D(^WV(790,DFN,0)) D  ;add patient to File 790, if not there
  1.  .D AUTOADD^WVPATE(DFN,DUZ(2),.WVERR)
  1.  .Q
  1.  Q:WVERR<0  ;quit if new patient could not be added to File 790
  1.  D FIND^WVLABAD1 ;check for 'unlinked' entry in File 790.1
  1.  I $D(^WV(790.1,"F",WVLABACC)) D  Q  ;link was made to existing entry
  1.  .D DELETE(WVIEN) ;delete lab test from list of choices
  1.  .S Y=+$O(^WV(790.1,"F",WVLABACC,0)) ;ien of procedure entry
  1.  .D EDIT ;edit procedure entry
  1.  .Q
  1.  S WVDR=".02////"_DFN
  1.  S WVDR=WVDR_";.04////"_WVPROC ;File 790.2 pointer
  1.  S:$P(WVNODE,U,7)]"" WVDR=WVDR_";.07////"_$P(WVNODE,U,7) ;provider
  1.  S WVDR=WVDR_";.1////"_$G(DUZ(2)) ;health care facility
  1.  S:$P(WVNODE,U,11)]"" WVDR=WVDR_";.11////"_$P(WVNODE,U,11) ;patient location
  1.  S WVDR=WVDR_";.12////"_$P(WVNODE,U,12) ;procedure date/time
  1.  S WVDR=WVDR_";.14////"_"o" ;status
  1.  S WVDR=WVDR_";.18////.5;.19////"_DT ;entering user and date
  1.  S WVDR=WVDR_";.34////"_$G(DUZ(2)) ;accessioning facility
  1.  S WVDR=WVDR_";2.17////"_$P(WVNODE,U,1) ;lab accession#
  1.  S WVDR=WVDR_";2.18////"_$P(WVNODE,U,36) ;Lab Data file (#63) pointer
  1.  S WVDR=WVDR_";2.19////"_$P(WVNODE,U,37) ;Lab Data file inverse d/t
  1.  S WVDR=WVDR_";2.2////"_$P(WVNODE,U,38) ;Lab Data file subscript (CY/SP)
  1.  ; add procedure to File 790.1
  1.  D NEW2^WVPROC(DFN,WVPROC,WVDATE,WVDR,"","",.WVERR)
  1.  I Y D DELETE(WVIEN)
  1.  I Y D EDIT
  1.  Q
  1. KILL ; Kill variables
  1.  D KILLALL^WVUTL8
  1.  K ^TMP("WVLAB",$J)
  1.  Q
  1. DELETE(WVIEN) ; Delete an entry from File 790.08
  1.  Q:'$G(WVIEN)
  1.  N DA,DIK,Y
  1.  S DA=WVIEN,DIK="^WV(790.08,"
  1.  D ^DIK
  1.  Q
  1. EDIT ; Edit WV PROCEDURE (#790.1) file entry
  1.  Q:'$G(Y)
  1.  D LT^WVPROC ;edit the new entry
  1.  S WVPOP=0 ;reset WVPOP which is killed by ^WVPROC call
  1.  Q
  1. DEFAULT ; Find next default look-up value.
  1.  ; WVQUIT - ien of File 790.08 entry
  1.  ; WVDICB - last entry checked (don't show an entry they bypassed)
  1.  N WVLOOP,WVNODE,WVQUIT
  1.  Q:$G(WVDICB)=""
  1.  S WVQUIT=0,WVLOOP=+WVDICB
  1.  F  S WVLOOP=$O(^WV(790.08,WVLOOP)) Q:'WVLOOP  D  Q:WVQUIT
  1.  .S WVNODE=$G(^WV(790.08,WVLOOP,0)) Q:WVNODE=""
  1.  .I $P(WVNODE,U,7)=DUZ D  Q  ;duz is requesting provider
  1.  ..S (WVDICB,WVQUIT)=WVLOOP
  1.  ..Q
  1.  .I $P($G(^WV(790,+$P(WVNODE,U,2),0)),U,10)=DUZ D  ;case mgr
  1.  ..S (WVDICB,WVQUIT)=WVLOOP
  1.  ..Q
  1.  .Q
  1.  S DIC("B")=$S(WVQUIT:$P(^WV(790.08,+WVQUIT,0),U,1),1:"")
  1.  K:DIC("B")="" DIC("B")
  1.  Q