IBBASWCH ;OAK/ELZ - PFSS MASTER SWITCH FUNCTIONS ;15-MAR-2005
;;2.0;INTEGRATED BILLING;**260**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
SWSTAT() ;get current switch status
N IBBRTRN,X
S X=$G(^IBBAS(372,1,1))
S IBBRTRN=+$P(X,"^",1)_"^"_+$P(X,"^",2)
Q IBBRTRN
;
ONOFF ;set switch
N DIR,DIRUT,DUOUT,IBBDUZ,IBBTURN,IBBCURST,IBBNEWST,IBBREAS,IBBQUE,IBBSTAT,IBBDTTM,IBBFOK,X,Y,XX
S IBBDUZ=DUZ,XX=$$CHKKEY(IBBDUZ)
I 'XX D Q
.W !!,"You do not have the Security Key required to use this option.",!,"Exiting...",!!
;
I XX D
.S IBBCURST=+$G(^IBBAS(372,1,1))
.S IBBNEWST=$S(IBBCURST:0,1:1),IBBTURN=$S(IBBNEWST:"ON",1:"OFF")
.;
.W !
.K DIR,DIRUT,DUOUT,X,Y
.S DIR(0)="YA",DIR("A")="Should the PFSS On/Off Switch be turned "_IBBTURN_" ? (Y/N): "
.D ^DIR
.Q:$D(DIRUT) Q:$D(DUOUT)
.Q:'Y
.W !
.K DIR,DIRUT,DUOUT,X,Y
.S DIR(0)="FA^10:80",DIR("A")="REASON: "
.S DIR("?")="What is the reason for changing the PFSS On/Off Switch status? [10-80 characters]"
.D ^DIR
.Q:$D(DIRUT) Q:$D(DUOUT)
.Q:(Y="^")
.W !
.S IBBREAS=Y
.K DIR,DIRUT,DUOUT,X,Y
.S DIR(0)="YA",DIR("A")="Are you sure the PFSS On/Off Switch should be turned "_IBBTURN_"? (Y/N): "
.D ^DIR
.Q:$D(DIRUT) Q:$D(DUOUT)
.Q:'Y
.W !
.S IBBQUE=0
.K DIR,DIRUT,DUOUT,X,Y
.S DIR(0)="YA",DIR("A")="Do you wish to queue this change for a later date/time ? (Y/N): "
.S DIR("?",1)="You may queue this change to the PFSS On/Off Switch for a later date/time."
.S DIR("?",2)="For example, you may want the change to take place during non-business"
.S DIR("?",3)="hours."
.S DIR("?",4)=" "
.S DIR("?")="If you opt not to queue the change, then it will be effective immediately."
.D ^DIR
.Q:$D(DIRUT) Q:$D(DUOUT)
.Q:(Y="^")
.I Y S IBBQUE=1
.I 'IBBQUE D
..W !!,"One moment please...",!
..D FILE
..I $G(IBBFOK) W !,"The PFSS On/Off Switch is now "_IBBTURN_".",!!
..I '$G(IBBFOK) D
...W !,"No update made to PFSS On/Off Switch.",!
...K X,Y S IBBSTAT=$$SWSTAT^IBBAPI(),IBBTURN=$S(+IBBSTAT:"ON",1:"OFF"),Y=$P(IBBSTAT,"^",2)
...D DD^%DT S IBBDTTM=$P(Y,"@",2)_" on "_$P(Y,"@",1)
...W !,"The PFSS On/Off Switch was set to "_IBBTURN_" at "_IBBDTTM_".",!
.I IBBQUE D
..S TASK=$$TASK(IBBDUZ,IBBCURST,IBBNEWST,IBBREAS,IBBTURN)
..I TASK W !!,"PFSS On/Off Switch change queued as Task #"_TASK_".",!
..I 'TASK W !!,"PFSS On/Off Switch change could not be queued.",!
Q
;
FILE ;file switch status in #372
N CURRENT,IBB,IBBIEN,IBBIENS,IBBMSG,IBBEFFDT
;multiple queued tasks could be for same update to switch status;
;do not continue if new status=current status
S IBBFOK=0
Q:'$$CHKKEY(IBBDUZ)
S CURRENT=+$P($G(^IBBAS(372,1,1)),"^",1)
I IBBNEWST=CURRENT Q
L +^IBBAS(372,1,1):5
I IBBNEWST'=CURRENT D
.;change switch status
.S IBBIEN(1)=""
.S IBBIENS="+1,1,"
.S IBBMSG="IBB(""DIERR"")"
.S IBBEFFDT=$$NOW^XLFDT()
.S FDA(372.01,IBBIENS,.01)=IBBEFFDT
.S FDA(372.01,IBBIENS,.02)=IBBCURST
.S FDA(372.01,IBBIENS,.03)=IBBDUZ
.S FDA(372.01,IBBIENS,.04)=IBBREAS
.D UPDATE^DIE("","FDA","IBBIEN",IBBMSG)
.I '$D(IBB("DIERR")) S ^IBBAS(372,1,1)=IBBNEWST_"^"_IBBEFFDT
L -^IBBAS(372,1,1)
S IBBFOK=1
Q
;
TASK(IBBDUZ,IBBCURST,IBBNEWST,IBBREAS,IBBTURN) ;queue switch change via TaskManager
N ZTRTN,ZTDESC,ZTDTH,ZTSAVE,ZTSK
Q:'$$CHKKEY(IBBDUZ) 0
S ZTDTH=""
S ZTIO="",ZTDESC="Set PFSS On/Off Switch to "_IBBTURN_" by "_IBBDUZ
S ZTSAVE("IBBDUZ")="",ZTSAVE("IBBCURST")="",ZTSAVE("IBBNEWST")="",ZTSAVE("IBBREAS")=""
S ZTRTN="FILE^IBBASWCH"
W !
D ^%ZTLOAD
Q $G(ZTSK)
;
CHKKEY(IBBDUZ) ;does user hold security key IBB MASTER SWITCH?
N X,Y,IBBKEY,DIC
S IBBKEY=0
S DIC=19.1,DIC(0)="MXZ",X="IBB MASTER SWITCH"
D ^DIC
I +Y'>0 Q IBBKEY
K X,Y
S DIC="^VA(200,"_IBBDUZ_",51,",DIC(0)="MXZ",X="IBB MASTER SWITCH"
D ^DIC
I +Y'>0 Q IBBKEY
S IBBKEY=+Y
Q IBBKEY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBBASWCH 3891 printed Oct 16, 2024@18:09:05 Page 2
IBBASWCH ;OAK/ELZ - PFSS MASTER SWITCH FUNCTIONS ;15-MAR-2005
+1 ;;2.0;INTEGRATED BILLING;**260**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
SWSTAT() ;get current switch status
+1 NEW IBBRTRN,X
+2 SET X=$GET(^IBBAS(372,1,1))
+3 SET IBBRTRN=+$PIECE(X,"^",1)_"^"_+$PIECE(X,"^",2)
+4 QUIT IBBRTRN
+5 ;
ONOFF ;set switch
+1 NEW DIR,DIRUT,DUOUT,IBBDUZ,IBBTURN,IBBCURST,IBBNEWST,IBBREAS,IBBQUE,IBBSTAT,IBBDTTM,IBBFOK,X,Y,XX
+2 SET IBBDUZ=DUZ
SET XX=$$CHKKEY(IBBDUZ)
+3 IF 'XX
Begin DoDot:1
+4 WRITE !!,"You do not have the Security Key required to use this option.",!,"Exiting...",!!
End DoDot:1
QUIT
+5 ;
+6 IF XX
Begin DoDot:1
+7 SET IBBCURST=+$GET(^IBBAS(372,1,1))
+8 SET IBBNEWST=$SELECT(IBBCURST:0,1:1)
SET IBBTURN=$SELECT(IBBNEWST:"ON",1:"OFF")
+9 ;
+10 WRITE !
+11 KILL DIR,DIRUT,DUOUT,X,Y
+12 SET DIR(0)="YA"
SET DIR("A")="Should the PFSS On/Off Switch be turned "_IBBTURN_" ? (Y/N): "
+13 DO ^DIR
+14 if $DATA(DIRUT)
QUIT
if $DATA(DUOUT)
QUIT
+15 if 'Y
QUIT
+16 WRITE !
+17 KILL DIR,DIRUT,DUOUT,X,Y
+18 SET DIR(0)="FA^10:80"
SET DIR("A")="REASON: "
+19 SET DIR("?")="What is the reason for changing the PFSS On/Off Switch status? [10-80 characters]"
+20 DO ^DIR
+21 if $DATA(DIRUT)
QUIT
if $DATA(DUOUT)
QUIT
+22 if (Y="^")
QUIT
+23 WRITE !
+24 SET IBBREAS=Y
+25 KILL DIR,DIRUT,DUOUT,X,Y
+26 SET DIR(0)="YA"
SET DIR("A")="Are you sure the PFSS On/Off Switch should be turned "_IBBTURN_"? (Y/N): "
+27 DO ^DIR
+28 if $DATA(DIRUT)
QUIT
if $DATA(DUOUT)
QUIT
+29 if 'Y
QUIT
+30 WRITE !
+31 SET IBBQUE=0
+32 KILL DIR,DIRUT,DUOUT,X,Y
+33 SET DIR(0)="YA"
SET DIR("A")="Do you wish to queue this change for a later date/time ? (Y/N): "
+34 SET DIR("?",1)="You may queue this change to the PFSS On/Off Switch for a later date/time."
+35 SET DIR("?",2)="For example, you may want the change to take place during non-business"
+36 SET DIR("?",3)="hours."
+37 SET DIR("?",4)=" "
+38 SET DIR("?")="If you opt not to queue the change, then it will be effective immediately."
+39 DO ^DIR
+40 if $DATA(DIRUT)
QUIT
if $DATA(DUOUT)
QUIT
+41 if (Y="^")
QUIT
+42 IF Y
SET IBBQUE=1
+43 IF 'IBBQUE
Begin DoDot:2
+44 WRITE !!,"One moment please...",!
+45 DO FILE
+46 IF $GET(IBBFOK)
WRITE !,"The PFSS On/Off Switch is now "_IBBTURN_".",!!
+47 IF '$GET(IBBFOK)
Begin DoDot:3
+48 WRITE !,"No update made to PFSS On/Off Switch.",!
+49 KILL X,Y
SET IBBSTAT=$$SWSTAT^IBBAPI()
SET IBBTURN=$SELECT(+IBBSTAT:"ON",1:"OFF")
SET Y=$PIECE(IBBSTAT,"^",2)
+50 DO DD^%DT
SET IBBDTTM=$PIECE(Y,"@",2)_" on "_$PIECE(Y,"@",1)
+51 WRITE !,"The PFSS On/Off Switch was set to "_IBBTURN_" at "_IBBDTTM_".",!
End DoDot:3
End DoDot:2
+52 IF IBBQUE
Begin DoDot:2
+53 SET TASK=$$TASK(IBBDUZ,IBBCURST,IBBNEWST,IBBREAS,IBBTURN)
+54 IF TASK
WRITE !!,"PFSS On/Off Switch change queued as Task #"_TASK_".",!
+55 IF 'TASK
WRITE !!,"PFSS On/Off Switch change could not be queued.",!
End DoDot:2
End DoDot:1
+56 QUIT
+57 ;
FILE ;file switch status in #372
+1 NEW CURRENT,IBB,IBBIEN,IBBIENS,IBBMSG,IBBEFFDT
+2 ;multiple queued tasks could be for same update to switch status;
+3 ;do not continue if new status=current status
+4 SET IBBFOK=0
+5 if '$$CHKKEY(IBBDUZ)
QUIT
+6 SET CURRENT=+$PIECE($GET(^IBBAS(372,1,1)),"^",1)
+7 IF IBBNEWST=CURRENT
QUIT
+8 LOCK +^IBBAS(372,1,1):5
+9 IF IBBNEWST'=CURRENT
Begin DoDot:1
+10 ;change switch status
+11 SET IBBIEN(1)=""
+12 SET IBBIENS="+1,1,"
+13 SET IBBMSG="IBB(""DIERR"")"
+14 SET IBBEFFDT=$$NOW^XLFDT()
+15 SET FDA(372.01,IBBIENS,.01)=IBBEFFDT
+16 SET FDA(372.01,IBBIENS,.02)=IBBCURST
+17 SET FDA(372.01,IBBIENS,.03)=IBBDUZ
+18 SET FDA(372.01,IBBIENS,.04)=IBBREAS
+19 DO UPDATE^DIE("","FDA","IBBIEN",IBBMSG)
+20 IF '$DATA(IBB("DIERR"))
SET ^IBBAS(372,1,1)=IBBNEWST_"^"_IBBEFFDT
End DoDot:1
+21 LOCK -^IBBAS(372,1,1)
+22 SET IBBFOK=1
+23 QUIT
+24 ;
TASK(IBBDUZ,IBBCURST,IBBNEWST,IBBREAS,IBBTURN) ;queue switch change via TaskManager
+1 NEW ZTRTN,ZTDESC,ZTDTH,ZTSAVE,ZTSK
+2 if '$$CHKKEY(IBBDUZ)
QUIT 0
+3 SET ZTDTH=""
+4 SET ZTIO=""
SET ZTDESC="Set PFSS On/Off Switch to "_IBBTURN_" by "_IBBDUZ
+5 SET ZTSAVE("IBBDUZ")=""
SET ZTSAVE("IBBCURST")=""
SET ZTSAVE("IBBNEWST")=""
SET ZTSAVE("IBBREAS")=""
+6 SET ZTRTN="FILE^IBBASWCH"
+7 WRITE !
+8 DO ^%ZTLOAD
+9 QUIT $GET(ZTSK)
+10 ;
CHKKEY(IBBDUZ) ;does user hold security key IBB MASTER SWITCH?
+1 NEW X,Y,IBBKEY,DIC
+2 SET IBBKEY=0
+3 SET DIC=19.1
SET DIC(0)="MXZ"
SET X="IBB MASTER SWITCH"
+4 DO ^DIC
+5 IF +Y'>0
QUIT IBBKEY
+6 KILL X,Y
+7 SET DIC="^VA(200,"_IBBDUZ_",51,"
SET DIC(0)="MXZ"
SET X="IBB MASTER SWITCH"
+8 DO ^DIC
+9 IF +Y'>0
QUIT IBBKEY
+10 SET IBBKEY=+Y
+11 QUIT IBBKEY
