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

VAFCEHU2.m

Go to the documentation of this file. 
  1. VAFCEHU2 ;ALB/JLU,LTL-UTILITIES FOR 391.98 AND 391.99 AND LIST MAN ;10/10/02  15:55
  1.  ;;5.3;Registration;**149,255,333,474,477,620,1015**;Aug 13, 1993;Build 21
  1. SORTS(SRT,ARY) ;
  1.  ;this tag will sort the exceptions in different formats depending on
  1.  ;what the user has selected.
  1.  ;
  1.  ;INPUTS - SRT this variable contains what sort is requested from the
  1.  ;list man patient review screen.
  1.  ; Ex.  SP  sort by patient
  1.  ;      SS  sort by site
  1.  ;      SO  sort by oldest event
  1.  ;      SN  sort by newest event
  1.  ;ARY - the array the calling program wants the info returned in.
  1.  ;
  1.  ;OUTPUT
  1.  ;a populated array that was passed in by the user.  The array is in
  1.  ;the structure xxx(#,0)=value
  1.  ;
  1.  S VAR=SRT_"(ARY)"
  1.  D @VAR
  1.  Q
  1.  ;
  1. SP(ARY) ;sort by patient
  1.  N LP,LP1,CTR
  1.  S LP=""
  1.  S CTR=1
  1.  F  S LP=$O(^DGCN(391.98,"C",LP)) Q:LP=""  F LP1=0:0 S LP1=$O(^DGCN(391.98,"C",LP,LP1)) Q:LP1=""  D BLD(LP1,ARY,.CTR)
  1.  Q
  1.  ;
  1. SS(ARY) ;sort by site
  1.  N LP,LP1,CTR
  1.  S LP=""
  1.  S CTR=1
  1.  F  S LP=$O(^DGCN(391.98,"FRM",LP)) Q:LP=""  F LP1=0:0 S LP1=$O(^DGCN(391.98,"FRM",LP,LP1)) Q:LP1=""  D BLD(LP1,ARY,.CTR)
  1.  Q
  1.  ;
  1. SO(ARY) ;sort by oldest event
  1.  N LP,LP1,CTR
  1.  S LP=""
  1.  S CTR=1
  1.  F  S LP=$O(^DGCN(391.98,"EVT",LP)) Q:LP=""  F LP1=0:0 S LP1=$O(^DGCN(391.98,"EVT",LP,LP1)) Q:LP1=""  D BLD(LP1,ARY,.CTR)
  1.  Q
  1.  ;
  1. SN(ARY) ;sort by newest event
  1.  N LP,LP1,CTR
  1.  S LP=999999999999
  1.  S CTR=1
  1.  F  S LP=$O(^DGCN(391.98,"EVT",LP),-1) Q:LP=""  F LP1=999999999999:0 S LP1=$O(^DGCN(391.98,"EVT",LP,LP1),-1) Q:LP1=""  D BLD(LP1,ARY,.CTR)
  1.  Q
  1.  ;
  1. BLD(LP1,ARY,CTR) ;this is the actual building subroutine.  the array that is
  1.  ;return is var(#,0)=value starting at 1.
  1.  ;
  1.  N DATA,STAT,PAT,XX
  1.  ;getting the exception
  1.  S DATA=$G(^DGCN(391.98,LP1,0))
  1.  Q:DATA']""
  1.  ;checking for the status
  1.  ;Q:$P(DATA,U,4)']"" ;**333
  1.  I $P(DATA,U,4)']"" S XX=$$EDIT^VAFCEHU1(LP1,"RETIRED DATA") Q  ;**333 retire
  1.  ;getting the status node from 391.984
  1.  S STAT=$G(^DGCN(391.984,$P(DATA,U,4),0))
  1.  ;if retired skip
  1.  I "RETIRED DATA"=$P(STAT,U,1) Q
  1.  ;if rejected skip
  1.  I "DATA REJECTED"=$P(STAT,U,1) Q
  1.  ;if merge complete
  1.  I "MERGE COMPLETE"=$P(STAT,U,1) Q
  1.  ;get patient file zero node
  1.  S PAT=$G(^DPT($P(DATA,U,1),0))
  1.  ;Q:PAT']"" ;**333
  1.  I $S(PAT']"":1,$$IFLOCAL^MPIF001(+$P(DATA,U,1)):1,$$IFVCCI^MPIF001(+$P(DATA,U,1))=-1:1,1:0) S XX=$$EDIT^VAFCEHU1(LP1,"RETIRED DATA") Q  ;**333 retire if a local, you're not the cmor or no cmor
  1.  S @ARY@(CTR,0)=$P(PAT,U,1)_U_$P(PAT,U,9)_U_$P(PAT,U,3)_U_$P(STAT,U,2)_U_$P(DATA,U,3)_U_$G(^DGCN(391.98,LP1,"FRM"))
  1.  S @ARY@(CTR,"VAFC")=LP1
  1.  S CTR=CTR+1
  1.  Q
  1.  ;
  1. FORMAT(ARY,VALMCNT,VALMQUIT) ;this subroutines formats the array in ARY
  1.  ;from file 391.98 for display by the list manager.  It accepts the
  1.  ;array name as its input in ARY.
  1.  ;VALMCNT and VALMQUIT are passed by reference
  1.  ;VALMCNT will be the total number of entries
  1.  ;VALMQUIT tells list man to quit if something when wrong.
  1.  ;
  1.  N CTR,STR,LP
  1.  S CTR=1
  1.  F LP=0:0 S LP=$O(@ARY@(LP)) Q:'LP  S STR=$G(@ARY@(LP,0)) I STR]"" DO
  1.  .N X,DATE
  1.  .S X=$$SETSTR^VALM1(CTR,"",1,4)
  1.  .S X=$$SETSTR^VALM1($E($P(STR,U,1),1,23),X,5,23)
  1.  .S X=$$SETSTR^VALM1($P(STR,U,2),X,29,9)
  1.  .S DATE=$$IN2EXDT^VAFCMGU0($P(STR,U,3))
  1.  .S X=$$SETSTR^VALM1(DATE,X,40,10)
  1.  .S X=$$SETSTR^VALM1($P(STR,U,4),X,51,2)
  1.  .S DATE=$$IN2EXDT^VAFCMGU0($P(STR,U,5))
  1.  .S X=$$SETSTR^VALM1(DATE,X,55,10)
  1.  .S X=$$SETSTR^VALM1($P(STR,U,6),X,67,$L($P(STR,U,6)))
  1.  .S @ARY@(LP,0)=X
  1.  .S @ARY@("IDX",CTR,CTR)=""
  1.  .S CTR=CTR+1
  1.  .Q
  1.  S VALMCNT=CTR-1
  1.  I CTR=1 DO
  1.  .S @ARY@(1,0)=""
  1.  .S @ARY@(2,0)="There are no exceptions on file to review."
  1.  .S VALMCNT=2
  1.  .Q
  1.  Q
  1.  ;
  1. FRMDATA(IEN,ARY) ;
  1.  ;This entry point will return all the data related to a given exception
  1.  ;INPUTS
  1.  ;  IEN - The IEN of the exception to be extracted.
  1.  ;  ARY - The array that the user wishes the information returned in.
  1.  ;        This array can be either local or global.
  1.  ;  Ex.   ^TMP("TEST",$J)
  1.  ;        If and array is not passed then a default global array will
  1.  ;        be used.  ^TMP($J,"VAFC-MRG","DATA")
  1.  ;OUTPUTS
  1.  ;  1 if the look up and retreival were successful
  1.  ;  0^description if they were not.
  1.  ;
  1.  N ERR,LP,DATA
  1.  I '$D(IEN) S ERR="0^Parameter not defined." G FRMQ
  1.  I IEN']"" S ERR="0^Exception not defined." G FRMQ
  1.  I '$D(^DGCN(391.98,IEN,0)) S ERR="0^Exception not in file." G FRMQ
  1.  I '$D(^DGCN(391.99,"B",IEN)) S ERR="0^Data for exception not defined." G FRMQ
  1.  I '$D(ARY) S ARY="^TMP($J,""VAFC-MRG"",""DATA"")"
  1.  I ARY']"" S ARY="^TMP($J,""VAFC-MRG"",""DATA"")"
  1.  S LP=""
  1.  F  S LP=$O(^DGCN(391.99,"B",IEN,LP)) Q:'LP  DO
  1.  . S DATA=$G(^DGCN(391.99,LP,0))
  1.  . Q:'DATA
  1.  . I $P(DATA,U,2)=""!($P(DATA,U,3)="") Q  ;**477
  1.  . I $S($P(DATA,U,3)=.211:1,$P(DATA,U,3)=.2403:1,1:0) D  ;**477 standardize mmn and nok for old pdr entries
  1.  . . N DGNAME S DGNAME=$G(^DGCN(391.99,LP,"VAL")) I $S(DGNAME="":0,DGNAME["@":0,1:1) D
  1.  . . . I $P(DATA,U,3)=.211 D STDNAME^XLFNAME(.DGNAME,"P") S DGNAME=$$FORMAT^XLFNAME7(.DGNAME,3,35) I DGNAME="" Q
  1.  . . . I $P(DATA,U,3)=.2403 D STDNAME^XLFNAME(.DGNAME,"P") S DGNAME=$$FORMAT^XLFNAME7(.DGNAME,3,35,,2,,1) I DGNAME="" Q
  1.  . . . D UPD(LP,50,DGNAME)
  1.  . I $P(DATA,U,3)=.05,($G(^DGCN(391.99,LP,"VAL"))="N") D UPD(LP,50,"NEVER MARRIED"),UPD(LP,.06,"@") S $P(DATA,"^",6)="" ;**477 translate marital status from 'n' to 'never married' and remove unresolved flag
  1.  . ;
  1.  . S @ARY@($P(DATA,U,2),$P(DATA,U,3))=$G(^DGCN(391.99,LP,"VAL"))_U_$P(DATA,U,5)_U_$P(DATA,U,6)
  1.  . Q
  1.  I $D(@ARY)>9 S ERR=1
  1.  E  S ERR="0^No elments found."
  1.  ;
  1. FRMQ Q ERR
  1.  ;
  1. REVFUL ;this entry point is to process the user selection from the summary
  1.  ;screen of the exception handler.
  1.  ;the variable VALMAR is expected.  This contains the array that is
  1.  ;being used as part of list manager
  1.  ;
  1.  ;variable collision during VAFCMG01 processing, changed ien to ienpdr ;**477
  1.  ;
  1.  S VALM("ENTITY")="Patient"
  1.  D EN^VALM2(XQORNOD(0))
  1.  I '$D(VALMY) G FULQ
  1.  N LP,RES
  1.  F LP=0:0 S LP=$O(VALMY(LP)) Q:'LP  DO  Q:RES<-9
  1.  .N IENPDR,LCK,MSG,EXCPT,FRM,STR,STAT,EDT,ARY
  1.  .S RES=0
  1.  .S IENPDR=$O(@VALMAR@("IDX",LP,0))
  1.  .Q:'IENPDR
  1.  .S IENPDR=$G(@VALMAR@(IENPDR,"VAFC"))
  1.  .Q:'IENPDR
  1.  .S LCK=$$LOCK^VAFCEHU1(IENPDR)
  1.  .I 'LCK DO  Q
  1.  ..N PAT
  1.  ..S PAT=$E(@VALMAR@(LP,0),4,27)
  1.  ..D FULL^VALM1
  1.  ..W $C(7)
  1.  ..W !!,"The status for ",PAT," is ",$P(LCK,U,2)
  1.  ..W !,"Review or merging of this data is not allowed at this time."
  1.  ..D PAUSE^VALM1
  1.  ..Q
  1.  .S EXCPT=$G(^DGCN(391.98,IENPDR,0))
  1.  .S FRM=$G(^DGCN(391.98,IENPDR,"FRM"))
  1.  .I 'EXCPT!(FRM']"") Q
  1.  .S ARY="^TMP($J,""VAFC-MRG"",""DATA"")"
  1.  .S STR=$$FRMDATA(IENPDR,ARY)
  1.  .Q:'STR
  1.  .S RES=$$EN^VAFCMG01($P(EXCPT,U,1),ARY,FRM,$P(EXCPT,U,3))
  1.  .S STAT=$S(RES>11:"DR",RES>9:"MC",RES<2:"DE",1:"AR")
  1.  .S EDT=$$EDIT^VAFCEHU1(IENPDR,STAT)
  1.  .I RES=10!(RES=11) D WHO(IENPDR,DUZ,"NOW")
  1.  .L -^DGCN(391.98,IENPDR) ;**255
  1.  .Q
  1.  D INIT2^VAFCEHLM
  1.  ;
  1. FULQ Q
  1.  ;
  1. WHO(IEN,WHO,WHEN) ;this entry point updates the exceptions as to who
  1.  ;made this update and when.
  1.  ;
  1.  S DIE="^DGCN(391.98,"
  1.  S DA=IEN
  1.  S DR="12////"_DUZ_";11///"_WHEN
  1.  D ^DIE
  1.  Q
  1.  ;
  1. RETPDR(DFN,STAIEN) ;retire site's PDRs 'awaiting review' for patient ;**474
  1.  ;INPUT    DFN - ien of the patient
  1.  ;      STAIEN - ien of the institution
  1.  ;
  1.  N DAT,IEN,NAM,PDRIEN,STANAM,VAFCINST
  1.  I 'DFN!'STAIEN Q
  1.  D GETS^DIQ(4,STAIEN_",",".01;999.1*",,"VAFCINST") ;retrieve current name and name history
  1.  S NAM=$G(VAFCINST(4,STAIEN_",",.01)) I NAM'="" S STANAM(NAM)="" ;get current name
  1.  S IEN="" F  S IEN=$O(VAFCINST(4.999,IEN)) Q:IEN=""  S NAM=$G(VAFCINST(4.999,IEN,.02)) I NAM'="" S STANAM(NAM)="" ;get name history in case site name change
  1.  S NAM="" F  S NAM=$O(STANAM(NAM)) Q:NAM=""  D  ;loop through array of names
  1.  . S DAT=0 F  S DAT=$O(^DGCN(391.98,"AKY",DFN,NAM,DAT)) Q:DAT=""  D  ;loop through site's pdrs for patient
  1.  . . S PDRIEN="" F  S PDRIEN=$O(^DGCN(391.98,"AKY",DFN,NAM,DAT,PDRIEN)) Q:'PDRIEN  I $P($G(^DGCN(391.98,PDRIEN,0)),"^",4)=1 S XX=$$EDIT^VAFCEHU1(PDRIEN,"RETIRED DATA") ;retire pdr's awaiting review
  1.  Q
  1.  ;
  1. UPD(DA,FLD,VAL) ;update value ;**477
  1.  L +^DGCN(391.99,DA,0):10
  1.  S DIE="^DGCN(391.99,"
  1.  S DR=FLD_"///^S X=VAL"
  1.  D ^DIE K DIE,DR
  1.  L -^DGCN(391.99,DA,0)
  1.  Q