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

ACRFDHRV.m

Go to the documentation of this file. 
  1. ACRFDHRV ;IHS/OIRM/DSD/AEF - DHR VISUAL VERIFY [ 11/01/2001   9:44 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGMT SYSTEM;;NOV 05, 2001
  1.  ;
  1.  ;This routine is used to visually verify DHR data in the DHR Data
  1.  ;Records file
  1.  ;
  1. EN ;EP -- VISUAL VERIFY MAIN ENTRY POINT      
  1.  ;
  1.  N ACRADD,ACRD0,ACRD1,ACRD2,ACRD3,ACROPT,ACROUT
  1.  D HOME^%ZIS
  1.  D ^XBKVAR
  1.  S (ACRADD,ACROUT)=0
  1.  S ACROPT="1^6"
  1.  D DISPLAY^ACRFDHRD(ACROPT)
  1.  D SEL^ACRFDHRE(.ACRD0,.ACRD1,.ACRD2,.ACROUT,ACRADD,ACROPT,$G(ACRCLR))
  1.  Q:$G(ACROUT)
  1.  I $P(^AFSHRCDS(ACRD0,0),U,2) D  G EN
  1.  . W *7,"This batch has been exported" H 2
  1.  D EDIT(ACRD0,ACRD1,ACRD2,.ACROUT)
  1.  G EN
  1. EDIT(ACRD0,ACRD1,ACRD2,ACROUT)         ;
  1.  ;----- EDIT RECORDS
  1.  ;
  1.  N ACRD3,ACRTYPE,Y
  1.  S ACRD3=0
  1.  F  S ACRD3=$O(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",ACRD3)) Q:'ACRD3  D  Q:$G(ACROUT)
  1.  . S ACRTYPE=$P(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",ACRD3,0),U,2)
  1.  . D EDIT^ACRFDHRE(ACRD0,ACRD1,ACRD2,ACRD3,ACRTYPE)
  1.  . D NEXT(ACRD0,ACRD1,ACRD2,.Y,.ACROUT) Q:$G(ACROUT)
  1.  . I +Y S ACRD3=+Y-1
  1.  Q
  1. NEXT(ACRD0,ACRD1,ACRD2,Y,ACROUT)       ;
  1.  ;----- PROMPT FOR NEXT RECORD
  1.  ;
  1. B ;       
  1.  N DIR,DIRUT,DTOUT,DUOUT
  1.  S DIR(0)="FO"
  1.  S DIR("A")="Next Record"
  1.  S DIR("B")="NEXT"
  1.  S DIR("?")="Enter RETURN to go to next record, '^' to quit, or record number ("_$O(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S","B",0))_"-"_$O(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S","B",99999),-1)_")"
  1.  D ^DIR
  1.  I $D(DTOUT)!($D(DUOUT))!($D(DIRUT)) S ACROUT=1 Q
  1.  Q:Y="NEXT"
  1.  I '$D(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S","B",+Y)) D  G B
  1.  . W *7,"    Non-existent record"
  1.  Q
  1. CLOSE ;EP -- CLOSE DHR BATCH
  1.  ;
  1.  ;      Closes DHR batch and adds trailer record
  1.  ;
  1.  N ACRADD,ACRD0,ACRD1,ACRD2,ACROUT
  1.  D HOME^%ZIS
  1.  D ^XBKVAR
  1.  S (ACRADD,ACROUT)=0
  1.  S ACROPT="1^6"
  1.  D DISPLAY^ACRFDHRD(ACROPT)
  1.  D SEL^ACRFDHRE(.ACRD0,.ACRD1,.ACRD2,.ACROUT,ACRADD,ACROPT,$G(ACRCLR))
  1.  Q:$G(ACROUT)
  1.  I $P(^AFSHRCDS(ACRD0,0),U,2) D  G CLOSE
  1.  . W *7,"This batch has been exported" H 2
  1.  D TRAIL^ACRFDHRE(ACRD0,ACRD1,ACRD2)
  1.  G CLOSE
  1.  Q
  1. SHOW ;EP -- DISPLAY DHR RECORDS
  1.  ;
  1.  N ACRADD,ACRD0,ACRD1,ACRD2,ACROPT,ACROUT
  1.  D HOME^%ZIS
  1.  D ^XBKVAR
  1.  S (ACRADD,ACROUT)=0
  1.  S ACROPT="1^6"
  1.  D DISPLAY^ACRFDHRD(ACROPT)
  1.  D SEL^ACRFDHRE(.ACRD0,.ACRD1,.ACRD2,.ACROUT,ACRADD,ACROPT,$G(ACRCLR))
  1.  Q:$G(ACROUT)
  1.  D LOOP(ACRD0,ACRD1,ACRD2,.ACROUT)
  1.  G SHOW
  1. LOOP(ACRD0,ACRD1,ACRD2,ACROUT)         ;
  1.  ;----- LOOP THROUGH DHR RECORDS
  1.  ;
  1.  N ACRD3,BY,DIC,FLDS,FR,IOP,L,TO,X,Y
  1.  S ACRD3=0
  1.  F  S ACRD3=$O(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",ACRD3)) Q:'ACRD3  D  Q:$G(ACROUT)
  1.  . S DIC="^AFSHRCDS("
  1.  . S L=0
  1.  . S FLDS="[ACRF DHR DISPLAY]"
  1.  . S BY=".01,1,.01,1,1,.01,1,1,6,.01"
  1.  . S FR=$S(ACRD0=1:"PCC-BLUE",ACRD0=2:"PCC-RED",ACRD0=3:"BCBS-BLUE",ACRD0=4:"BCBS-RED",ACRD0=5:"ARMS-BLUE",ACRD0=6:"ARMS-RED",1:"")
  1.  . S FR=FR_","_ACRD1_","
  1.  . S FR=FR_$P($G(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0)),U)
  1.  . S FR=FR_","_ACRD3
  1.  . S TO=FR
  1.  . S IOP="HOME"
  1.  . D EN1^DIP
  1.  . D NEXT(ACRD0,ACRD1,ACRD2,.Y,.ACROUT)
  1.  . I +Y S ACRD3=+Y-1
  1.  Q
  1. LIST ;EP -- LIST DHR RECORDS IN BATCH
  1.  ;
  1.  N ACRADD,ACRD0,ACRD1,ACRD2,ACROPT,ACROUT,BY,DIR,FLDS,FR,L,TO,X,Y
  1.  D HOME^%ZIS
  1.  D ^XBKVAR
  1.  S (ACRADD,ACROUT)=0
  1.  S ACROPT="1^6"
  1.  D DISPLAY^ACRFDHRD(ACROPT)
  1.  D SEL^ACRFDHRE(.ACRD0,.ACRD1,.ACRD2,.ACROUT,ACRADD,ACROPT,$G(ACRCLR))
  1.  Q:$G(ACROUT)
  1.  S DIC="^AFSHRCDS("
  1.  S L=0
  1.  S FLDS="[ACRF DHR STR DISPLAY]"
  1.  S BY="@.01,1,@.01,1,1,@.01,1,1,6,@.01"
  1.  S FR=$S(ACRD0=1:"PCC-BLUE",ACRD0=2:"PCC-RED",ACRD0=3:"BCBS-BLUE",ACRD0=4:"BCBS-RED",ACRD0=5:"ARMS-BLUE",ACRD0=6:"ARMS-RED",1:"")
  1.  S FR=FR_","_ACRD1_","
  1.  S FR=FR_$P($G(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0)),U)
  1.  S TO=FR
  1.  S FR=FR_","_1
  1.  S TO=TO_","_99999
  1.  D EN1^DIP
  1.  S DIR(0)="E"
  1.  D ^DIR
  1.  G LIST
  1.  Q
  1. BDEL ;EP -- DELETE BATCH
  1.  ;
  1.  N ACRADD,ACRD0,ACRD1,ACRD2,ACROPT,ACROUT,BATCH,DA,DIK,DIR,X,Y
  1.  D HOME^%ZIS
  1.  D ^XBKVAR
  1.  S (ACRADD,ACROUT)=0
  1.  S ACROPT="1^6"
  1.  D DISPLAY^ACRFDHRD(ACROPT)
  1.  D SEL^ACRFDHRE(.ACRD0,.ACRD1,.ACRD2,.ACROUT,ACRADD,ACROPT,$G(ACRCLR))
  1.  Q:$G(ACROUT)
  1.  S BATCH=$$DATE^ACRFDHRE($P(^AFSHRCDS(ACRD0,"D",ACRD1,0),U))_"-"_$P(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0),U)
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Are you sure you want to delete batch "_BATCH
  1.  S DIR("B")="NO"
  1.  W *7
  1.  D ^DIR
  1.  K DIR
  1.  G BDEL:'Y
  1.  S DA(2)=ACRD0
  1.  S DA(1)=ACRD1
  1.  S DA=ACRD2
  1.  S DIK="^AFSHRCDS("_DA(2)_","_"""D"""_","_DA(1)_","_"""I"""_","
  1.  D ^DIK
  1.  W !,BATCH,"   <DELETED>"
  1.  H 2
  1.  G BDEL
  1.  Q
  1. STR(X) ;----- FORMAT DHR DATA STRING FOR DISPLAY
  1.  ;
  1.  ;      USED BY [ACRF DHR STR DISPLAY] PRINT TEMPLATE
  1.  ;
  1.  ;      X = The string to be formatted - from the zero node of 
  1.  ;          the Sequence Number subfile of the DHR Data Records file
  1.  ;
  1.  N Y,Z
  1.  S Z=$$PAD^ACRFUTL($P(X,U),"L",3,"")
  1.  S Z=Z_"  "
  1.  S Z=Z_$$PAD^ACRFUTL($P(X,U,2),"R",1,"")
  1.  S Y=$P(X,U,3)
  1.  S Y=$E(Y,4,7)_$E(Y,2,3)
  1.  S Z=Z_$$PAD^ACRFUTL(Y,"R",6,"")
  1.  S Z=Z_$$PAD^ACRFUTL($P(X,U,4),"R",3,"")
  1.  S Z=Z_$$PAD^ACRFUTL($P(X,U,5),"R",1,"")
  1.  S Z=Z_$$PAD^ACRFUTL($P(X,U,6),"R",1,"")
  1.  S Z=Z_$$PAD^ACRFUTL($P(X,U,7),"R",3,"")
  1.  S Z=Z_$$PAD^ACRFUTL($P(X,U,8),"R",10,"")
  1.  S Z=Z_$$PAD^ACRFUTL($P(X,U,9),"R",3,"")
  1.  S Z=Z_$$PAD^ACRFUTL($P(X,U,10),"R",10,"")
  1.  S Z=Z_$$PAD^ACRFUTL($P(X,U,11),"R",1,"")
  1.  S Z=Z_$$PAD^ACRFUTL($P(X,U,12),"R",1,"")
  1.  S Z=Z_$$PAD^ACRFUTL($P(X,U,13),"R",7,"")
  1.  S Z=Z_$$PAD^ACRFUTL($P(X,U,14),"R",4,"")
  1.  S Z=Z_$$PAD^ACRFUTL($P(X,U,15),"L",12,$S($P(X,U,2)=3:"",1:0))
  1.  S Z=Z_$$PAD^ACRFUTL($P(X,U,16),"R",1,"")
  1.  S Z=Z_$$PAD^ACRFUTL($P(X,U,17),"R",15,"")
  1.  Q Z