source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBBASWCH.m@ 776

Last change on this file since 776 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1IBBASWCH ;OAK/ELZ - PFSS MASTER SWITCH FUNCTIONS ;15-MAR-2005
2 ;;2.0;INTEGRATED BILLING;**260**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5SWSTAT() ;get current switch status
6 N IBBRTRN,X
7 S X=$G(^IBBAS(372,1,1))
8 S IBBRTRN=+$P(X,"^",1)_"^"_+$P(X,"^",2)
9 Q IBBRTRN
10 ;
11ONOFF ;set switch
12 N DIR,DIRUT,DUOUT,IBBDUZ,IBBTURN,IBBCURST,IBBNEWST,IBBREAS,IBBQUE,IBBSTAT,IBBDTTM,IBBFOK,X,Y,XX
13 S IBBDUZ=DUZ,XX=$$CHKKEY(IBBDUZ)
14 I 'XX D Q
15 .W !!,"You do not have the Security Key required to use this option.",!,"Exiting...",!!
16 ;
17 I XX D
18 .S IBBCURST=+$G(^IBBAS(372,1,1))
19 .S IBBNEWST=$S(IBBCURST:0,1:1),IBBTURN=$S(IBBNEWST:"ON",1:"OFF")
20 .;
21 .W !
22 .K DIR,DIRUT,DUOUT,X,Y
23 .S DIR(0)="YA",DIR("A")="Should the PFSS On/Off Switch be turned "_IBBTURN_" ? (Y/N): "
24 .D ^DIR
25 .Q:$D(DIRUT) Q:$D(DUOUT)
26 .Q:'Y
27 .W !
28 .K DIR,DIRUT,DUOUT,X,Y
29 .S DIR(0)="FA^10:80",DIR("A")="REASON: "
30 .S DIR("?")="What is the reason for changing the PFSS On/Off Switch status? [10-80 characters]"
31 .D ^DIR
32 .Q:$D(DIRUT) Q:$D(DUOUT)
33 .Q:(Y="^")
34 .W !
35 .S IBBREAS=Y
36 .K DIR,DIRUT,DUOUT,X,Y
37 .S DIR(0)="YA",DIR("A")="Are you sure the PFSS On/Off Switch should be turned "_IBBTURN_"? (Y/N): "
38 .D ^DIR
39 .Q:$D(DIRUT) Q:$D(DUOUT)
40 .Q:'Y
41 .W !
42 .S IBBQUE=0
43 .K DIR,DIRUT,DUOUT,X,Y
44 .S DIR(0)="YA",DIR("A")="Do you wish to queue this change for a later date/time ? (Y/N): "
45 .S DIR("?",1)="You may queue this change to the PFSS On/Off Switch for a later date/time."
46 .S DIR("?",2)="For example, you may want the change to take place during non-business"
47 .S DIR("?",3)="hours."
48 .S DIR("?",4)=" "
49 .S DIR("?")="If you opt not to queue the change, then it will be effective immediately."
50 .D ^DIR
51 .Q:$D(DIRUT) Q:$D(DUOUT)
52 .Q:(Y="^")
53 .I Y S IBBQUE=1
54 .I 'IBBQUE D
55 ..W !!,"One moment please...",!
56 ..D FILE
57 ..I $G(IBBFOK) W !,"The PFSS On/Off Switch is now "_IBBTURN_".",!!
58 ..I '$G(IBBFOK) D
59 ...W !,"No update made to PFSS On/Off Switch.",!
60 ...K X,Y S IBBSTAT=$$SWSTAT^IBBAPI(),IBBTURN=$S(+IBBSTAT:"ON",1:"OFF"),Y=$P(IBBSTAT,"^",2)
61 ...D DD^%DT S IBBDTTM=$P(Y,"@",2)_" on "_$P(Y,"@",1)
62 ...W !,"The PFSS On/Off Switch was set to "_IBBTURN_" at "_IBBDTTM_".",!
63 .I IBBQUE D
64 ..S TASK=$$TASK(IBBDUZ,IBBCURST,IBBNEWST,IBBREAS,IBBTURN)
65 ..I TASK W !!,"PFSS On/Off Switch change queued as Task #"_TASK_".",!
66 ..I 'TASK W !!,"PFSS On/Off Switch change could not be queued.",!
67 Q
68 ;
69FILE ;file switch status in #372
70 N CURRENT,IBB,IBBIEN,IBBIENS,IBBMSG,IBBEFFDT
71 ;multiple queued tasks could be for same update to switch status;
72 ;do not continue if new status=current status
73 S IBBFOK=0
74 Q:'$$CHKKEY(IBBDUZ)
75 S CURRENT=+$P($G(^IBBAS(372,1,1)),"^",1)
76 I IBBNEWST=CURRENT Q
77 L +^IBBAS(372,1,1):5
78 I IBBNEWST'=CURRENT D
79 .;change switch status
80 .S IBBIEN(1)=""
81 .S IBBIENS="+1,1,"
82 .S IBBMSG="IBB(""DIERR"")"
83 .S IBBEFFDT=$$NOW^XLFDT()
84 .S FDA(372.01,IBBIENS,.01)=IBBEFFDT
85 .S FDA(372.01,IBBIENS,.02)=IBBCURST
86 .S FDA(372.01,IBBIENS,.03)=IBBDUZ
87 .S FDA(372.01,IBBIENS,.04)=IBBREAS
88 .D UPDATE^DIE("","FDA","IBBIEN",IBBMSG)
89 .I '$D(IBB("DIERR")) S ^IBBAS(372,1,1)=IBBNEWST_"^"_IBBEFFDT
90 L -^IBBAS(372,1,1)
91 S IBBFOK=1
92 Q
93 ;
94TASK(IBBDUZ,IBBCURST,IBBNEWST,IBBREAS,IBBTURN) ;queue switch change via TaskManager
95 N ZTRTN,ZTDESC,ZTDTH,ZTSAVE,ZTSK
96 Q:'$$CHKKEY(IBBDUZ) 0
97 S ZTDTH=""
98 S ZTIO="",ZTDESC="Set PFSS On/Off Switch to "_IBBTURN_" by "_IBBDUZ
99 S ZTSAVE("IBBDUZ")="",ZTSAVE("IBBCURST")="",ZTSAVE("IBBNEWST")="",ZTSAVE("IBBREAS")=""
100 S ZTRTN="FILE^IBBASWCH"
101 W !
102 D ^%ZTLOAD
103 Q $G(ZTSK)
104 ;
105CHKKEY(IBBDUZ) ;does user hold security key IBB MASTER SWITCH?
106 N X,Y,IBBKEY,DIC
107 S IBBKEY=0
108 S DIC=19.1,DIC(0)="MXZ",X="IBB MASTER SWITCH"
109 D ^DIC
110 I +Y'>0 Q IBBKEY
111 K X,Y
112 S DIC="^VA(200,"_IBBDUZ_",51,",DIC(0)="MXZ",X="IBB MASTER SWITCH"
113 D ^DIC
114 I +Y'>0 Q IBBKEY
115 S IBBKEY=+Y
116 Q IBBKEY
Note: See TracBrowser for help on using the repository browser.