GMPLISRV ; SLC/MKB -- Problem List Service file utility ;8/26/93 16:30
;;2.0;Problem List;;Aug 25, 1994
EN ; Main entry point
;W !!!?5,"*** Please update your Service File (#49) at this time ***"
N X D HELP,NOTE
EN1 I $D(^DIC(49,"F")) S DIR(0)="E" D ^DIR G:'Y ENQ W @IOF D CURRENT
F D Q:$D(GMPDONE)!($D(GMPQUIT))
. R !,"Select CLINICAL SERVICE: ",X:DTIME
. I '$T!(X["^") S GMPQUIT=1 Q
. I X="" S GMPDONE=1 Q
. I X="?" D HELP,CURRENT Q
. I X["??" D HELP H 3 D LISTALL Q
. I X?1"-".E D REMOVE Q
. D ADD
ENQ K GMPSERV,GMPDONE,GMPQUIT,GMPRMOVE
Q
;
HELP ; Write [introductory] help text
W !!?10,"Please designate those services that are clinical, that are"
W !?10,"directly involved in patient care, by entering them below."
W !?10,"If you select a 'parent' service, you will have the option"
W !?10,"to automatically mark all of its sub-services as well."
W !?10,"To de-select a service as clinical, enter the name of the"
W !?10,"service preceded by a minus sign (-)."
Q
;
NOTE ; Display additional note
W !!,?10,"NOTE:"
W !?10,"Problems will be assigned a category based upon the service"
W !?10,"of the clinician responsible for entering and/or treating"
W !?10,"them; ONLY clinical services will be allowed. The problem"
W !?10,"list may then be searched or displayed according to the"
W !?10,"desired discipline.",!!
Q
;
CURRENT ; Display currently designated clinical services, in GMPSERV()
N DIC,D,DZ W !!,"CURRENTLY SELECTED CLINICAL SERVICES"
S DIC="^DIC(49,",DIC(0)="E",DIC("S")="I $P(^(0),U,9)=""C"""
S D="B",DZ="??" D DQ^DICQ
Q
;
LISTALL ; Display all entries in the Service file
N DIC,D,DZ W !!,"ALL "_$P($G(^DIC(4,+$G(DUZ(2)),0)),U)_" SERVICES"
S DIC="^DIC(49,",DIC(0)="E",D="B",DZ="??"
D DQ^DICQ
Q
;
CKPG ; Check paging
N DIR,X,Y
I $Y>(IOSL-4) S DIR(0)="E" D ^DIR S:'Y GMPQUIT=1
Q
;
REMOVE ; Delete clinical flag
N DIC,DR,DA,DIE
S X=$E(X,2,999),DIC="^DIC(49,",DIC(0)="EQM" D ^DIC Q:Y<0
S DA=+Y,DIE=DIC,DR="1.7////@" D ^DIE
W ?50,"... Clinical flag removed",!
Q
;
ADD ; Add clinical flag to service
N DIC,DR,DA,DIE,GMPIFN
S DIC="^DIC(49,",DIC(0)="EQM" D ^DIC Q:Y<0
S DA=+Y,DIE=DIC,DR="1.7////C" D ^DIE
W " ... Clinical flag added",!
Q:'$D(^DIC(49,"ACHLD",DA)) ; not a parent service
W !,$P(^DIC(49,DA,0),U)_" has the following sub-services: " S GMPIFN=DA
F I=0:0 S I=$O(^DIC(49,"ACHLD",GMPIFN,I)) Q:I'>0 W !?3,$P(^DIC(49,I,0),U)
Q:'$$INCLCHLD^GMPLPRF1(GMPIFN) ; don't include sub-services
F I=0:0 S I=$O(^DIC(49,"ACHLD",GMPIFN,I)) Q:I'>0 D
. S DA=I,DR="1.7////C" D ^DIE
. W !?3,$P(^DIC(49,I,0),U)_" ... Clinical flag added"
W !
Q
GMPLISRV ; SLC/MKB -- Problem List Service file utility ;8/26/93 16:30
+1 ;;2.0;Problem List;;Aug 25, 1994
EN ; Main entry point
+1 ;W !!!?5,"*** Please update your Service File (#49) at this time ***"
+2 NEW X
DO HELP
DO NOTE
EN1 IF $DATA(^DIC(49,"F"))
SET DIR(0)="E"
DO ^DIR
IF 'Y
GOTO ENQ
WRITE @IOF
DO CURRENT
+1 FOR
Begin DoDot:1
+2 READ !,"Select CLINICAL SERVICE: ",X:DTIME
+3 IF '$TEST!(X["^")
SET GMPQUIT=1
QUIT
+4 IF X=""
SET GMPDONE=1
QUIT
+5 IF X="?"
DO HELP
DO CURRENT
QUIT
+6 IF X["??"
DO HELP
HANG 3
DO LISTALL
QUIT
+7 IF X?1"-".E
DO REMOVE
QUIT
+8 DO ADD
End DoDot:1
IF $DATA(GMPDONE)!($DATA(GMPQUIT))
QUIT
ENQ KILL GMPSERV,GMPDONE,GMPQUIT,GMPRMOVE
+1 QUIT
+2 ;
HELP ; Write [introductory] help text
+1 WRITE !!?10,"Please designate those services that are clinical, that are"
+2 WRITE !?10,"directly involved in patient care, by entering them below."
+3 WRITE !?10,"If you select a 'parent' service, you will have the option"
+4 WRITE !?10,"to automatically mark all of its sub-services as well."
+5 WRITE !?10,"To de-select a service as clinical, enter the name of the"
+6 WRITE !?10,"service preceded by a minus sign (-)."
+7 QUIT
+8 ;
NOTE ; Display additional note
+1 WRITE !!,?10,"NOTE:"
+2 WRITE !?10,"Problems will be assigned a category based upon the service"
+3 WRITE !?10,"of the clinician responsible for entering and/or treating"
+4 WRITE !?10,"them; ONLY clinical services will be allowed. The problem"
+5 WRITE !?10,"list may then be searched or displayed according to the"
+6 WRITE !?10,"desired discipline.",!!
+7 QUIT
+8 ;
CURRENT ; Display currently designated clinical services, in GMPSERV()
+1 NEW DIC,D,DZ
WRITE !!,"CURRENTLY SELECTED CLINICAL SERVICES"
+2 SET DIC="^DIC(49,"
SET DIC(0)="E"
SET DIC("S")="I $P(^(0),U,9)=""C"""
+3 SET D="B"
SET DZ="??"
DO DQ^DICQ
+4 QUIT
+5 ;
LISTALL ; Display all entries in the Service file
+1 NEW DIC,D,DZ
WRITE !!,"ALL "_$PIECE($GET(^DIC(4,+$GET(DUZ(2)),0)),U)_" SERVICES"
+2 SET DIC="^DIC(49,"
SET DIC(0)="E"
SET D="B"
SET DZ="??"
+3 DO DQ^DICQ
+4 QUIT
+5 ;
CKPG ; Check paging
+1 NEW DIR,X,Y
+2 IF $Y>(IOSL-4)
SET DIR(0)="E"
DO ^DIR
IF 'Y
SET GMPQUIT=1
+3 QUIT
+4 ;
REMOVE ; Delete clinical flag
+1 NEW DIC,DR,DA,DIE
+2 SET X=$EXTRACT(X,2,999)
SET DIC="^DIC(49,"
SET DIC(0)="EQM"
DO ^DIC
IF Y<0
QUIT
+3 SET DA=+Y
SET DIE=DIC
SET DR="1.7////@"
DO ^DIE
+4 WRITE ?50,"... Clinical flag removed",!
+5 QUIT
+6 ;
ADD ; Add clinical flag to service
+1 NEW DIC,DR,DA,DIE,GMPIFN
+2 SET DIC="^DIC(49,"
SET DIC(0)="EQM"
DO ^DIC
IF Y<0
QUIT
+3 SET DA=+Y
SET DIE=DIC
SET DR="1.7////C"
DO ^DIE
+4 WRITE " ... Clinical flag added",!
+5 ; not a parent service
IF '$DATA(^DIC(49,"ACHLD",DA))
QUIT
+6 WRITE !,$PIECE(^DIC(49,DA,0),U)_" has the following sub-services: "
SET GMPIFN=DA
+7 FOR I=0:0
SET I=$ORDER(^DIC(49,"ACHLD",GMPIFN,I))
IF I'>0
QUIT
WRITE !?3,$PIECE(^DIC(49,I,0),U)
+8 ; don't include sub-services
IF '$$INCLCHLD^GMPLPRF1(GMPIFN)
QUIT
+9 FOR I=0:0
SET I=$ORDER(^DIC(49,"ACHLD",GMPIFN,I))
IF I'>0
QUIT
Begin DoDot:1
+10 SET DA=I
SET DR="1.7////C"
DO ^DIE
+11 WRITE !?3,$PIECE(^DIC(49,I,0),U)_" ... Clinical flag added"
End DoDot:1
+12 WRITE !
+13 QUIT
