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

APCDCVDT.m

Go to the documentation of this file. 
  1. APCDCVDT ; IHS/CMI/LAB - CHANGE VISIT DATE ;
  1.  ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1.  ;
  1.  ; ***** WARNING ***** This routine executes the cross-references
  1.  ; on the .03 field (except the "AD") in order to reset the "AA"
  1.  ; cross-reference.  Very dangerous assumptions here.  For one,
  1.  ; if the date of the VISIT was used on any other field it would
  1.  ; not be reset.
  1.  ;
  1.  ; Array APCDCVDT must be passed as follows:
  1.  ;
  1.  ;  APCDCVDT("VISIT DFN")=DFN of VISIT entry being changed.
  1.  ;  APCDCVDT("VISIT DATE/TIME")=date and time to be changed to in
  1.  ;                              internal FileMan form.
  1.  ;  APCDCVDT("TALK")=any value including NULL
  1.  ;
  1.  ; If APCDCVDT("TALK") exists a dot (.) will be printed for
  1.  ; each V FILE entry processed during both passes.
  1.  ;
  1.  ; Upon exit APCDCVDT("ERROR FLAG") will exist if an error was
  1.  ; detected.
  1.  ;
  1.  ; It is the callers responsibility to KILL APCDCVDT.
  1.  ;
  1. START ;PEP - CALLED TO DELETE A PCC VISIT
  1.  D CHK
  1.  Q:$D(APCDCVDT("ERROR FLAG"))
  1.  D PROCESS
  1.  D MOD
  1.  D EOJ
  1.  Q
  1.  ;
  1. MOD ;
  1.  S AUPNVSIT=APCDCVDT("VISIT DFN") D MOD^AUPNVSIT
  1.  Q
  1. CHK ; CHECK PASSED ARRAY
  1.  K APCDCVDT("ERROR FLAG")
  1.  I $D(APCDCVDT("VISIT DFN"))#2,APCDCVDT("VISIT DFN"),$D(APCDCVDT("VISIT DATE/TIME"))#2,APCDCVDT("VISIT DATE/TIME"),APCDCVDT("VISIT DATE/TIME")#1 Q
  1.  S APCDCVDT("ERROR FLAG")=1
  1.  Q
  1.  ;
  1. PROCESS ;
  1.  I '$D(^AUPNVSIT(APCDCVDT("VISIT DFN"),0)) S APCDCVDT("ERROR FLAG")=2 Q
  1.  S AUPNVSIT=APCDCVDT("VISIT DFN")
  1.  S APCDCVOD=+^AUPNVSIT(AUPNVSIT,0),APCDCVOT=APCDCVOD#1,APCDCVOD=APCDCVOD\1
  1.  S APCDCVND=APCDCVDT("VISIT DATE/TIME")\1,APCDCVNT=APCDCVDT("VISIT DATE/TIME")#1
  1.  I APCDCVOD=APCDCVND,APCDCVOT=APCDCVNT Q
  1.  I '$D(AUPNPAT),$P(^AUPNVSIT(AUPNVSIT,0),U,5) S Y=$P(^(0),U,5) D ^AUPNPAT
  1.  I APCDCVOD=APCDCVND D TIME Q
  1.  D DATE
  1.  Q
  1.  ;
  1. TIME ; CHANGE TIME ONLY
  1.  D CHGVISIT
  1.  Q
  1.  ;
  1. DATE ; CHANGE DATE/TIME
  1.  S APCDCVDZ=2 D VFILES
  1.  D CHGVISIT
  1.  S APCDCVDZ=1 D VFILES
  1.  Q
  1.  ;
  1. CHGVISIT ; CHANGE VISIT ENTRY
  1.  S DA=AUPNVSIT,DIE="^AUPNVSIT(",DR=".01///"_APCDCVND_APCDCVNT D ^DIE K DA,DIE,DR
  1.  Q
  1.  ;
  1. VFILES ; CHANGE V FILES
  1.  S APCDCVDF=9000010 F APCDCVDL=0:0 S APCDCVDF=$O(^DIC(APCDCVDF)) Q:APCDCVDF>9000010.99!(APCDCVDF'=+APCDCVDF)  D VFILE
  1.  K APCDCVDF,APCDCVDG,APCDCVDL,APCDCVDE,APCDCVDX
  1.  Q
  1.  ;
  1. VFILE ; CHANGE ONE V FILE
  1.  S APCDCVDG=^DIC(APCDCVDF,0,"GL")
  1.  Q:'$D(@(APCDCVDG_"""AD"","_AUPNVSIT_")"))
  1.  S APCDCVDE="" F APCDCVDL=0:0 S APCDCVDE=$O(@(APCDCVDG_"""AD"","_AUPNVSIT_",APCDCVDE)")) Q:APCDCVDE=""  D VFILEE
  1.  Q
  1. VFILEE ; CHANGE ONE V FILE ENTRY
  1.  ;
  1.  ; ***** WARNING ****** Using ^DIK here will not work!
  1.  ;
  1.  S APCDCVDX=0 F APCDCVDL=0:0 S APCDCVDX=$O(^DD(APCDCVDF,.03,1,APCDCVDX)) Q:APCDCVDX'=+APCDCVDX  I ^DD(APCDCVDF,.03,1,APCDCVDX,APCDCVDZ)'["""AD""" S DA=APCDCVDE,X=AUPNVSIT X ^DD(APCDCVDF,.03,1,APCDCVDX,APCDCVDZ)
  1.  W:$D(APCDCVDT("TALK")) "."
  1.  Q
  1.  ;
  1. EOJ ; EOJ CLEANUP
  1.  K %,%DT,C,D,D0,DA,DIC,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DQ,DR,I,X,Y
  1.  K APCDCVDE,APCDCVDF,APCDCVDG,APCDCVDL,APCDCVDX,APCDCVDZ,APCDCVND,APCDCVNT,APCDCVOD,APCDCVOT
  1.  Q