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

PSGRPNT.m

Go to the documentation of this file.

PSGRPNT ;BIR/CML3-REPOINT SITE POINTERS ;16 DEC 97 / 1:37 PM

 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97

ONLY1 ;

 S Q=0 F QQ=-1:1 S Q=$O(^PS(59.4,Q)) Q:'Q

 I 'QQ W $C(7),!!,"THIS IS YOUR ONLY SITE!",!,"(You must create another site before you can delete this one.)" Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGRPNT   276     printed  Nov 22, 2024@17:13:11                                                                                                                                                                                                      Page 2

PSGRPNT   ;BIR/CML3-REPOINT SITE POINTERS ;16 DEC 97 / 1:37 PM

 +1       ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97

 +2       ;

ONLY1     ;

 +1        SET Q=0

           FOR QQ=-1:1

               SET Q=$ORDER(^PS(59.4,Q))

               if 'Q

                   QUIT

 +2        IF 'QQ

               WRITE $CHAR(7),!!,"THIS IS YOUR ONLY SITE!",!,"(You must create another site before you can delete this one.)"

               QUIT