AIBCVT00.m

AIBCVT00 ;IHS/DDPS/DFM-IBM STAT RECORDS SITE PARAMETERS [ 01/12/89  1:06 PM ]

 ;1.3; 12/31/88 RESTRUCTURE, SEPERATE SITE ROUTINE

 S AIBJSL=$P(^AUTTSITE(1,0),U,1),AIBJSA=$P(^AUTTLOC(AIBJSL,0),U,4)

 S AIBJSAC=$P(^AUTTAREA(AIBJSA,0),U,2) I $L(AIBJSAC)>0 G CKAREAN

 S AIBMSG="No Area Code in RPMS Site file - Program Aborted",AIBA="A" G RETURN

CKAREAN ;GET AREA NAME

 S AIBJSAN=$P(^AUTTAREA(AIBJSA,0),U,1) I $L(AIBJSAN)>0 G CKACCTP

 S AIBMSG="No Area Name in RPMS Site file - Program Aborted",AIBA="A"

 G RETURN

CKACCTP ;GET AREA'S ACCOUNTING POINT

 S AIBJSAP=$P(^AUTTSITE(1,0),U,2) I $L(AIBJSAP)>0 G CKREMDPS

 S AIBMSG="No Area Accounting Point in RPMS Site file - Program Aborted"

 S AIBA="A" G RETURN

CKREMDPS ;GET AREA'S REMOTE ID FOR DDPS MAINFRAME

 S AIBJSRD=$P(^AUTTSITE(1,0),U,3) I $L(AIBJSRD)>0 G CKREMPCC

 S AIBMSG="Parameter for DDPS Remote not present in RPMS Site file - Program Aborted"

 S AIBA="A" G RETURN

CKREMPCC ;GET AREA'S REMOTE ID FOR PARKLAWN MAINFRAME

 S AIBJSRP=$P(^AUTTSITE(1,0),U,4) I $L(AIBJSRP)>0 G CKREMNIH

 S AIBMSG="Parameter for PCC Remote not present in RPMS Site file - Program Aborted"

 S AIBA="A" G RETURN

CKREMNIH ;GET AREA'S REMOTE ID FOR NATIONAL INSTITUTE OF HEALTH MAINFRAME

 S AIBJSRN=$P(^AUTTSITE(1,0),U,5) I $L(AIBJSRN)>0 G RETURN

 S AIBMSG="Parameter for NIH Remote not present in RPMS Site file - Program Aborted"

 S AIBA="A" G RETURN

RETURN ;RETURN TO CALLING ROUTINE

 Q

AIBCVT00  ;IHS/DDPS/DFM-IBM STAT RECORDS SITE PARAMETERS [ 01/12/89  1:06 PM ]

 +1       ;1.3; 12/31/88 RESTRUCTURE, SEPERATE SITE ROUTINE

 +2        SET AIBJSL=$PIECE(^AUTTSITE(1,0),U,1)

           SET AIBJSA=$PIECE(^AUTTLOC(AIBJSL,0),U,4)

 +3        SET AIBJSAC=$PIECE(^AUTTAREA(AIBJSA,0),U,2)

           IF $LENGTH(AIBJSAC)>0

               GOTO CKAREAN

 +4        SET AIBMSG="No Area Code in RPMS Site file - Program Aborted"

           SET AIBA="A"

           GOTO RETURN

CKAREAN   ;GET AREA NAME

 +1        SET AIBJSAN=$PIECE(^AUTTAREA(AIBJSA,0),U,1)

           IF $LENGTH(AIBJSAN)>0

               GOTO CKACCTP

 +2        SET AIBMSG="No Area Name in RPMS Site file - Program Aborted"

           SET AIBA="A"

 +3        GOTO RETURN

CKACCTP   ;GET AREA'S ACCOUNTING POINT

 +1        SET AIBJSAP=$PIECE(^AUTTSITE(1,0),U,2)

           IF $LENGTH(AIBJSAP)>0

               GOTO CKREMDPS

 +2        SET AIBMSG="No Area Accounting Point in RPMS Site file - Program Aborted"

 +3        SET AIBA="A"

           GOTO RETURN

CKREMDPS  ;GET AREA'S REMOTE ID FOR DDPS MAINFRAME

 +1        SET AIBJSRD=$PIECE(^AUTTSITE(1,0),U,3)

           IF $LENGTH(AIBJSRD)>0

               GOTO CKREMPCC

 +2        SET AIBMSG="Parameter for DDPS Remote not present in RPMS Site file - Program Aborted"

 +3        SET AIBA="A"

           GOTO RETURN

CKREMPCC  ;GET AREA'S REMOTE ID FOR PARKLAWN MAINFRAME

 +1        SET AIBJSRP=$PIECE(^AUTTSITE(1,0),U,4)

           IF $LENGTH(AIBJSRP)>0

               GOTO CKREMNIH

 +2        SET AIBMSG="Parameter for PCC Remote not present in RPMS Site file - Program Aborted"

 +3        SET AIBA="A"

           GOTO RETURN

CKREMNIH  ;GET AREA'S REMOTE ID FOR NATIONAL INSTITUTE OF HEALTH MAINFRAME

 +1        SET AIBJSRN=$PIECE(^AUTTSITE(1,0),U,5)

           IF $LENGTH(AIBJSRN)>0

               GOTO RETURN

 +2        SET AIBMSG="Parameter for NIH Remote not present in RPMS Site file - Program Aborted"

 +3        SET AIBA="A"

           GOTO RETURN

RETURN    ;RETURN TO CALLING ROUTINE

 +1        QUIT