AQAOPAR1 ; IHS/ORDC/LJF - ADT SERVICE LINKS ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtn contains an entry point called by ^AQAOPAR. The code deals
;with the user interface in assigning services to each RPMS link.
;
CURRENT ;ENTRY POINT >>> find all services currently linked
S AQAODR1=".0"_($E(AQAOI,3)+2) ;yes/no field
S X="1"_($E(AQAOI,3)+2),AQAODR2=$S($D(^DD(9002166.42,X,0)):X,1:"") ;#
;
W @IOF,!!?20,"SERVICES CURRENTLY LINKED TO "
W $P(^DD(9002166.4,AQAOI,0),U),!!
K AQAOCUR S AQAOX=0 ;get service ifns
F S AQAOX=$O(^AQAGP(AQAOFAC,"SRV",AQAOX)) Q:AQAOX'=+AQAOX D
.K DIQ K ^UTILITY("DIQ1",$J) S DIC=9002166.4,DA=AQAOFAC,DR="9000"
.S (AQAODA,DA(9002166.42))=AQAOX
.S (AQAODR,DR(9002166.42))=".01;"_AQAODR1
.D EN^DIQ1 Q:^UTILITY("DIQ1",$J,9002166.42,AQAODA,AQAODR1)'="YES"
.S AQAOCUR(AQAOX)=^UTILITY("DIQ1",$J,9002166.42,AQAODA,.01)
;
I '$D(AQAOCUR) W !!,"NO SERVICES CURRENTLY LINKED",! G ADD
;
W !! S AQAOX=0
F S AQAOX=$O(AQAOCUR(AQAOX)) Q:AQAOX="" D
.W !,AQAOCUR(AQAOX)
.I AQAODR2]"" D
..K ^UTILITY("DIQ1",$J) S DIC="^AQAGP(",DA=AQAOFAC,DR="9000"
..S (AQAODA,DA(9002166.42))=AQAOX
..S (AQAODR,DR(9002166.42))=AQAODR2 D EN^DIQ1
..W ?40,^UTILITY("DIQ1",$J,9002166.42,AQAODA,AQAODR)," DAYS"
;
EDIT ; >>> ask if user wants to edit or delete any current services
W !! K DIR S DIR(0)="YO",DIR("B")="NO"
S DIR("A")="Do you want to EDIT or DELETE any current services"
D ^DIR G EXIT:$D(DIRUT),ADD:Y=0
;
W !!!,">>> MODIFY/DELETE MODE . . ."
CHOOSE1 W !! K DIC,DIR S DIC="^AQAGP("_AQAOFAC_",""SRV"",",DIC(0)="AEMQZ"
S DIC("S")="I $D(AQAOCUR(Y))" D ^DIC
G EXIT:X=U,EXIT:$D(DTOUT),ADD:X="",CHOOSE1:Y=-1
K DIE S DIE="^AQAGP("_AQAOFAC_",""SRV"","
S DA=+Y,DA(1)=AQAOFAC,DR=AQAODR1_";"_AQAODR2 D ^DIE
G CHOOSE1
;
;
ADD ; >>> ask if user wants to add new services
W !! K DIR S DIR(0)="YO",DIR("B")="NO"
S DIR("A")="Do you want to ADD any new services to this link"
D ^DIR G EXIT:$D(DIRUT),EXIT:Y=0
;
W !!!,">>> ADD MODE . . ."
CHOOSE2 W !! K DIC,DIR S DIC="^DIC(49,",DIC(0)="AEMQZ"
D ^DIC G EXIT:X=U,EXIT:$D(DTOUT),EXIT:X="",CHOOSE2:Y=-1 S AQAOY=+Y
I '$D(^AQAGP(AQAOFAC,"SRV","B",+Y)) D ;add serv multiple
.S ^AQAGP(AQAOFAC,"SRV",0)="^9002166.42P"
.S DIC(0)="L",DIC="^AQAGP("_AQAOFAC_",""SRV"",",DA(1)=AQAOFAC
.S X=$P(Y,U,2) D ^DIC
K DIE S DIE="^AQAGP("_AQAOFAC_",""SRV"",",DA(1)=AQAOFAC
S DA=$O(^AQAGP(AQAOFAC,"SRV","B",AQAOY,0)),DR=AQAODR1_"////1;"_AQAODR2
I DA]"" D ^DIE
G CHOOSE2
;
;
EXIT ; >>> eoj
Q ;return to calling rtn AQAOPAR
AQAOPAR1 ; IHS/ORDC/LJF - ADT SERVICE LINKS ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtn contains an entry point called by ^AQAOPAR. The code deals
+4 ;with the user interface in assigning services to each RPMS link.
+5 ;
CURRENT ;ENTRY POINT >>> find all services currently linked
+1 ;yes/no field
SET AQAODR1=".0"_($EXTRACT(AQAOI,3)+2)
+2 ;#
SET X="1"_($EXTRACT(AQAOI,3)+2)
SET AQAODR2=$SELECT($DATA(^DD(9002166.42,X,0)):X,1:"")
+3 ;
+4 WRITE @IOF,!!?20,"SERVICES CURRENTLY LINKED TO "
+5 WRITE $PIECE(^DD(9002166.4,AQAOI,0),U),!!
+6 ;get service ifns
KILL AQAOCUR
SET AQAOX=0
+7 FOR
SET AQAOX=$ORDER(^AQAGP(AQAOFAC,"SRV",AQAOX))
IF AQAOX'=+AQAOX
QUIT
Begin DoDot:1
+8 KILL DIQ
KILL ^UTILITY("DIQ1",$JOB)
SET DIC=9002166.4
SET DA=AQAOFAC
SET DR="9000"
+9 SET (AQAODA,DA(9002166.42))=AQAOX
+10 SET (AQAODR,DR(9002166.42))=".01;"_AQAODR1
+11 DO EN^DIQ1
IF ^UTILITY("DIQ1",$JOB,9002166.42,AQAODA,AQAODR1)'="YES"
QUIT
+12 SET AQAOCUR(AQAOX)=^UTILITY("DIQ1",$JOB,9002166.42,AQAODA,.01)
End DoDot:1
+13 ;
+14 IF '$DATA(AQAOCUR)
WRITE !!,"NO SERVICES CURRENTLY LINKED",!
GOTO ADD
+15 ;
+16 WRITE !!
SET AQAOX=0
+17 FOR
SET AQAOX=$ORDER(AQAOCUR(AQAOX))
IF AQAOX=""
QUIT
Begin DoDot:1
+18 WRITE !,AQAOCUR(AQAOX)
+19 IF AQAODR2]""
Begin DoDot:2
+20 KILL ^UTILITY("DIQ1",$JOB)
SET DIC="^AQAGP("
SET DA=AQAOFAC
SET DR="9000"
+21 SET (AQAODA,DA(9002166.42))=AQAOX
+22 SET (AQAODR,DR(9002166.42))=AQAODR2
DO EN^DIQ1
+23 WRITE ?40,^UTILITY("DIQ1",$JOB,9002166.42,AQAODA,AQAODR)," DAYS"
End DoDot:2
End DoDot:1
+24 ;
EDIT ; >>> ask if user wants to edit or delete any current services
+1 WRITE !!
KILL DIR
SET DIR(0)="YO"
SET DIR("B")="NO"
+2 SET DIR("A")="Do you want to EDIT or DELETE any current services"
+3 DO ^DIR
IF $DATA(DIRUT)
GOTO EXIT
IF Y=0
GOTO ADD
+4 ;
+5 WRITE !!!,">>> MODIFY/DELETE MODE . . ."
CHOOSE1 WRITE !!
KILL DIC,DIR
SET DIC="^AQAGP("_AQAOFAC_",""SRV"","
SET DIC(0)="AEMQZ"
+1 SET DIC("S")="I $D(AQAOCUR(Y))"
DO ^DIC
+2 IF X=U
GOTO EXIT
IF $DATA(DTOUT)
GOTO EXIT
IF X=""
GOTO ADD
IF Y=-1
GOTO CHOOSE1
+3 KILL DIE
SET DIE="^AQAGP("_AQAOFAC_",""SRV"","
+4 SET DA=+Y
SET DA(1)=AQAOFAC
SET DR=AQAODR1_";"_AQAODR2
DO ^DIE
+5 GOTO CHOOSE1
+6 ;
+7 ;
ADD ; >>> ask if user wants to add new services
+1 WRITE !!
KILL DIR
SET DIR(0)="YO"
SET DIR("B")="NO"
+2 SET DIR("A")="Do you want to ADD any new services to this link"
+3 DO ^DIR
IF $DATA(DIRUT)
GOTO EXIT
IF Y=0
GOTO EXIT
+4 ;
+5 WRITE !!!,">>> ADD MODE . . ."
CHOOSE2 WRITE !!
KILL DIC,DIR
SET DIC="^DIC(49,"
SET DIC(0)="AEMQZ"
+1 DO ^DIC
IF X=U
GOTO EXIT
IF $DATA(DTOUT)
GOTO EXIT
IF X=""
GOTO EXIT
IF Y=-1
GOTO CHOOSE2
SET AQAOY=+Y
+2 ;add serv multiple
IF '$DATA(^AQAGP(AQAOFAC,"SRV","B",+Y))
Begin DoDot:1
+3 SET ^AQAGP(AQAOFAC,"SRV",0)="^9002166.42P"
+4 SET DIC(0)="L"
SET DIC="^AQAGP("_AQAOFAC_",""SRV"","
SET DA(1)=AQAOFAC
+5 SET X=$PIECE(Y,U,2)
DO ^DIC
End DoDot:1
+6 KILL DIE
SET DIE="^AQAGP("_AQAOFAC_",""SRV"","
SET DA(1)=AQAOFAC
+7 SET DA=$ORDER(^AQAGP(AQAOFAC,"SRV","B",AQAOY,0))
SET DR=AQAODR1_"////1;"_AQAODR2
+8 IF DA]""
DO ^DIE
+9 GOTO CHOOSE2
+10 ;
+11 ;
EXIT ; >>> eoj
+1 ;return to calling rtn AQAOPAR
QUIT
