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

AIBMRG.m

Go to the documentation of this file.
  1. AIBMRG ;RPMS/CMB/TJF ;GENERIC IBM DATA GLOBAL MERGE ROUTINE [ 02/01/89 8:29 AM ]
  1. ;1.3; 1/13/89 DISALLOW MULTIPLE MERGES FOR A SINGLE FACILITY
  1. ;1.3 ;ALLOW READ DSM ON MSM, CHS LOGIC & DISALLOW MULTIPLE MERGE
  1. ;1.3; 9/23/88 RESTRUCTURE, ALLOW FOR REGISTRATION ELIGIBILITY AND PCC FILES
  1. ;1.00 ;2/12/88
  1. INTRO ;INITIALIZATION LOGIC
  1. S:'$D(DTIME) DTIME=300 S:'$D(AIBFFN) AIBFFN=""
  1. W !,"GENERIC MERGE FILE TO GLOBAL PROGRAM FOR IBM RECORDS"
  1. BEGIN ;ENTRY POINT FOR FRONT END TELECOMMUNICATIONS PROGRAM AIBTCFLM
  1. D INIT^AIBMRG1 G:AIBA="A" ABEND G:AIBA="C" OPCANCL S AIBPSV=AIBPARMS
  1. U AIBDEV R AIBTIME:DTIME X AIBTONL G:'$T FILERROR
  1. I $E(AIBTIME)="~"!($E(AIBTIME)="|") G PCCMSG
  1. G READCMT
  1. PCCMSG ;SET SWITCH FOR PCC LOGIC AND DISPLAY MESSAGE
  1. S AIBPCC=1
  1. U AIBCDV W !,"Begin merging Patient Care Component records"
  1. S AIBGV=AIBTIME G PCCGBLNM
  1. READCMT ;READ COMMENT FROM SAVED GLOBAL FILE
  1. U AIBDEV R AIBCMT:DTIME X AIBTONL G:'$T FILERROR I AIBTIME="" G FILERROR
  1. U AIBCDV S AIBSEQ=1
  1. W !!,"Global saved at ",AIBTIME,".",!,"Header comment is : ",AIBCMT,!
  1. START ;BEGIN MERGING FILE
  1. U AIBCDV W !!,"Begin Merging of Global: "
  1. NEXTGBL ;PROCESS NEXT FILE
  1. K AIBGSEL
  1. NEXTVOL ;PROCESS NEXT VOLUME OF FILE
  1. U AIBDEV I AIBPCC G SKIPSUBZ
  1. R AIBGN:DTIME X AIBTONL G:'$T FILERROR
  1. SKIPSUBZ ;SKIP READ OF ZEROTH NODE SUBSCRIPT DATA - PCC FLAT FILE
  1. R AIBGV:DTIME X AIBTONL G:'$T FILERROR G:AIBPCC PCCGBLNM
  1. I AIBGN="*E" D NEXTFILE^AIBMRG1 G NEXTVOL:'QUIT
  1. G ENDFILE:AIBGN="**",FILERROR:AIBGN="",NEXTGBL:AIBGN="*"
  1. I $E(AIBGN)="*" S AIBGSEL=$E(AIBGN,2,999) G NEXTVOL
  1. S AIBGNN=$P(AIBGN,"("),AIBGNL=$L(AIBGNN)+1 S:'$D(AIBGSEL) AIBGSEL=AIBGNN
  1. I $L(AIBGV)>0 G INITINDR
  1. I AIBOS="D" G NEXTGBL
  1. R "INPUT FILE APPEARS TO IN DSM FORMAT, IS THIS CORRECT? (Y,N) Y// ",X:DTIME I X["N" G FILERROR
  1. G NEXTGBL
  1. PCCGBLNM ;INITIALIZE GLOBAL PREFIX NAME FOR PCC
  1. S (AIBGSEL,AIBGNN)="^APCC",AIBGNL=6
  1. INITINDR ;INITIALIZE INDIRECTION VARIABLES
  1. D FACTSET^AIBMRG1
  1. I $D(@AIBGBLN) G RTVGTZN
  1. S @AIBGBLN="9999999^0^0^0^0"
  1. RTVGTZN ;RETREVE VARIABLES FROM GRAND TOTAL ZEROTH NODE IN MERGE GLOBAL
  1. D ZERSET^AIBMRG1 G:AIBA="A" ABEND
  1. S AIBZN=AIBZN+1
  1. RTVFCZN ;RETREIVE FACILITY DATA FROM ZEROTH FACILITY NODE IN MERGE GLOBAL
  1. D FACSET^AIBMRG1 G:AIBA="A" ABEND
  1. I AIBS>0 G:AIBGSEL["AGTX" NOMRG G:AIBGSEL["APCC" NOMRG
  1. S AIBCT=AIBS+1
  1. S (AIBRC,AIBNC)=0
  1. I AIBPCC S (AIBRC,AIBNC)=1 G BLDNODE
  1. READ ;READ NEXT RECORD NODE DATA FROM INPUT FILE
  1. U AIBDEV I AIBPCC G SKIPSUBD
  1. R AIBGN:DTIME X AIBTONL G:'$T FILERROR
  1. SKIPSUBD ;SKIP SUBSCRIPTS FOR DATA RECORDS - PCC FLAT FILE
  1. R AIBGV:DTIME X AIBTONL G:'$T FILERROR G:AIBPCC CKPCCEOF
  1. G:AIBGN="" FILERROR I AIBGN="*E" D NEXTFILE^AIBMRG1 G READ:'QUIT
  1. G:$E(AIBGN,1,7)="**END**" ENDFILE ; OKC FORMAT
  1. I AIBGN="*" U AIBCDV W !," ... Global Merged" G NEXTGBL
  1. G NEXTGBL:AIBGN="*",ENDFILE:AIBGN="**"
  1. G BLDNODE
  1. CKPCCEOF ;END OF FILE LOGIC FOR PCC FLAT FILE
  1. G:$E(AIBGV)="~"!($E(AIBGV)="|") SETPCCID G ENDFILE
  1. SETPCCID ;SET NODE ID PIECE FOR PCC
  1. S AIBGV="PCC"_U_AIBGV
  1. BLDNODE ;PLACE DATA IN MERGE GLOBAL RECORD NODE
  1. S:"^ACHS"=$E(AIBGSEL,1,5) AIBGV="CHS"_U_AIBGV
  1. S @AIBGBLD=AIBGV
  1. S AIBCT=AIBCT+1,AIBNC=AIBNC+1 I $E(AIBGV,1,3)'="RG1" S AIBRC=AIBRC+1
  1. E G READ
  1. U AIBCDV S AIBRM=AIBRC#10 G:AIBRM>0 READ
  1. S AIBLK="",AIBLK=AIBLK_$J("",8-$L(AIBRC)) W AIBLK,AIBRC G READ
  1. ENDFILE ;END OF FILE PROCESSING
  1. D UPDATE^AIBMRG1
  1. I AIBFFN=2 G QUIT
  1. R !,"Merge Another? Y// ",AIBA:DTIME
  1. S:AIBA="" AIBA="Y" G:"YESyes"[AIBA BEGIN G QUIT
  1. NOMRG ;DISALLOW MULTIPLE MERGE FOR A FACILITY
  1. S AIBMSG="Records for this facility already on file - additional merge not allowed" G ABEND
  1. FILERROR ;ERROR IN FILE FORMAT - ABEND AFTER MESSAGE
  1. S AIBMSG="Invalid backup format...unable to merge."
  1. ABEND ;ABNORMAL END OF JOB
  1. D ABEND^AIBCVT6 D KILLVAR^AIBMRG1 G QUIT
  1. OPCANCL ;ABEND BECAUSE OPERATOR CANCLED JOB
  1. D OPCANCL^AIBCVT6 D KILLVAR^AIBMRG1 G QUIT
  1. QUIT ;
  1. K AIBOS G RETURN
  1. RETURN ;RETURN TO CALLING PROGRAM
  1. Q