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

ACHSYSR.m

Go to the documentation of this file.
  1. ACHSYSR ; IHS/ITSC/PMF - display database record for given PO; [ 10/16/2001 10:13 AM ]
  1. ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
  1. ;
  1. ; Displays raw database record for a given PO
  1. ;
  1. S U="^",CM=",",QT=""""
  1. ;
  1. S STOP=0
  1. F D START Q:STOP
  1. Q
  1. ;
  1. START ;
  1. W !!!!!!!!!!!!!!!!!!!!!!!!!
  1. D YEAR I STOP Q
  1. D NUM I STOP Q
  1. D SHOW
  1. Q
  1. ;
  1. ;
  1. YEAR ;
  1. W !!,"year:",?22
  1. D READ^ACHSFU
  1. I Y="" S STOP=1 Q
  1. I Y'?1N W " one digit please" G YEAR
  1. S YEAR=Y
  1. Q
  1. NUM ;
  1. W !!,"number:",?22
  1. D READ^ACHSFU
  1. I Y="" S STOP=1 Q
  1. I Y'?5N W " five digits please" G NUM
  1. S NUM=Y
  1. Q
  1. ;
  1. SHOW ;
  1. W !!!!!!!
  1. S SS=1_YEAR_NUM
  1. K LIST
  1. S FAC=0 F S FAC=$O(^ACHSF(FAC)) Q:'FAC I $D(^ACHSF(FAC,"D","B",SS)) S LIST=$G(LIST)+1,LIST(FAC,$O(^ACHSF(FAC,"D","B",SS,"")))=""
  1. I 'LIST W !!,"NOT FOUND" Q
  1. ;
  1. S FAC=$O(LIST("")),SS=$O(LIST(FAC,""))
  1. S GLOB="^ACHSF("_FAC_CM_QT_"D"_QT_CM_SS_")"
  1. F S GLOB=$Q(@GLOB) Q:GLOB="" Q:GLOB'[SS W !!,GLOB,"=",@GLOB
  1. W !!!
  1. I $$DIR^XBDIR("E","Press RETURN...")
  1. Q