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

AZXZSUP.m

Go to the documentation of this file. 
  1. AZXZSUP ;SUPPORT DATABASE PROGRAM [ 05/01/95   1:25 PM ]
  1.  ;04/01/92   JOHN H. LYNCH
  1.  ;
  1.  ;A TOOL USED FOR RECORDING AND TRACKING
  1.  ;SUPPORT CALLS FROM SERVICE UNITS UNDER
  1.  ;PHOENIX AREA INDIAN HEALTH SERVICE.
  1.  
  1. MAIN ;AZXZSUP PROGRAM CONTROL
  1.  ;SET LOCAL VARIABLES
  1.  ;D ^XBKSET  ;THIS LINE SHOULD BE UNCOMMENTED IF RUNNING IN
  1.              ;PROGRAMMERS' MODE ONLY!
  1.  
  1.  D MAINMENU
  1.  K OPTION,DIE("NO^"),SNUM,DIE,INUM,TCOUNT,DA,LOOK,DR,YN,PIEC
  1.  Q
  1.  
  1.  ;CLEAR SCREEN
  1.  W @IOF
  1.  
  1.  W !!!,?27,"RPMS Support Database"
  1.  W !,?21,"Phoenix Area Indian Health Service"
  1.  W !!!,?21,"Enter/Edit Support Calls.......[1]"
  1.  W !,?21,"Delete Support Calls...........[2]"
  1.  W !,?21,"Update Status of Support Calls.[3]"
  1.  W !,?21,"For Future Use.................[4]"
  1.  W !,?21,"Quit...........................[5]"
  1.  W !!,?33,"Option: " R OPTION
  1.  I OPTION=1 D ENTRY G MAINMENU  
  1.  I OPTION=2 D ^AZXZSUP1 G MAINMENU
  1.  I OPTION=3 D ^AZXZSUP2 G MAINMENU
  1.  I OPTION=4 G MAINMENU
  1.  I (OPTION=5)!(OPTION="")!(OPTION="^") Q  
  1.  G MAINMENU
  1.  Q
  1.  
  1. ENTRY ;ENTER/EDIT SUPPORT CALLS ROUTINE
  1.  ;SET LOCAL VARIABLES
  1.  S DIE("NO^")="NO JUMPING/EXIT" ;KEEP THEM FROM JUMPING OR EXITING
  1.  S DIE="1991012"  ;1991012 = ^SUPPDB (DATABASE GLOBAL)
  1.  
  1.  ;CLEAR SCREEN
  1.  W @IOF
  1.  
  1.  W !!!,"ONE MOMENT PLEASE..."
  1.  W !!!!  H 1
  1.  
  1. SUPPNUM ;Select SUPPORT NUMBER:  SUB-ROUTINE
  1.  ;SET LOCAL VARIABLES
  1.  S INUM=$P(^DIZ(DIE,0),U,3) ;INUM = CURRENT INTERNAL NUMBER
  1.  S TCOUNT=$P(^DIZ(DIE,0),U,4) ;TCOUNT = TOTAL COUNT CURR. IN FILE
  1.  
  1.  W !,"Select Support Number: ",INUM+1,"// "
  1.  R SNUM
  1.  
  1.  ;USER CHOOSING DEFAULT AS NEW ENTRY
  1.  I SNUM="" S SNUM=INUM+1
  1.  
  1.  ;IF "^" QUIT AND RETURN TO MAINMENU
  1.  I SNUM="^"  Q
  1.  
  1.  ;IF "?" GIVE HELP AND RETURN TO SUPPNUM SUB-ROUTINE
  1.  I SNUM="?" W !!,"Please enter your support log number or press return and accept the default for a new entry.",! G SUPPNUM
  1.  
  1.  ;ACCEPT SNUM AS A NEW ENTRY - INCREMENT COUNTERS IN ^DIZ(DIE,0)
  1.  I (SNUM=(INUM+1)) S $P(^DIZ(DIE,0),U,3)=INUM+1,$P(^DIZ(DIE,0),U,4)=TCOUNT+1 
  1.  ;USER IS TRYING TO ENTER A NUMBER OUT OF SEQUENCE
  1.  I SNUM>(INUM+1)  W !!,"SKIPPING SUPPORT NUMBERS IS NOT ALLOWED!",*7 H 3 G ENTRY
  1.  ;LOOK UP USER INPUT TO SEE IF IT EXISTS - IF NOT SAY ITS BEEN DELETED
  1.  S PIEC=0
  1.  I (SNUM<(INUM+1))&('$O(^DIZ(DIE,"B",SNUM,PIEC))) W !!,"SUPPORT NUMBER, ",SNUM,", HAS ALREADY BEEN DELETED!",! H 3 G SUPPNUM
  1.  
  1.  S DA=SNUM
  1.  S DR=".01///^S X=DA;.05:7"     ;DR - STUFF .01(SUPPORT NUMBER)
  1.  ;CALL FILEMAN TO ENTER/EDIT ^SUPPDB (DATABASE GLOBAL)
  1.  L ^DIZ(DIE,DA):0 I '$T  W !!,"RECORD HAS BEEN LOCKED, TRY AGAIN LATER!",!  H 3 G SUPPNUM
  1.  D ^DIE L  
  1.  
  1.  W !!!!
  1.  R !,"DO YOU WANT TO CONTINUE WITH ENTER/EDIT? Y// ",YN
  1.  
  1.  I (YN="Y")!(YN="") G ENTRY  ;STAY IN ENTRY SUB-ROUNTINE
  1.  Q                           ;OTHERWISE RETURN TO MAINMENU
  1.