- 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
