source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCCVCST.m@ 1270

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

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1SCCVCST ;ALB/TMP - Scheduling Conversion Template Utilities - CST; NOV 25, 1997
2 ;;5.3;Scheduling;**211**;Aug 13, 1993
3 ;
4NEW ; -- Add a new 'CST' Template entry
5 D FULL^VALM1
6 N DA,DD,DIC,DIE,DR,DIK,DIR,DO,SC,SCADD,SCCV,SCCV0,SCRESULT,X,Y
7 ;
8 ; -- make sure earilest date is set
9 IF '$G(^SD(404.91,1,"CNV")) D G NEWQ
10 . W !!,">>> You must set the 'Earlieat Encounter Date' parameter before"
11 . W !," a template can be added."
12 . W !!," Please use the 'Display/Edit Parameters' action to set this parameter."
13 . D PAUSE^SCCVU
14 ;
15 I $G(SCCVDONE) D DONE^SCCVCST1 G NEWQ
16 S DIC="^SD(404.98,",DIC("DR")="[SCCV CREATE TEMPLATE]",DIC(0)="LZ",X=$O(^SD(404.98,"A"),-1)+1 D FILE^DICN K DIC,DD,DO I Y<0 S SCRESULT=""
17 I Y>0 D
18 . S SCCV=+Y,SCCV0=Y(0)
19 . K SC
20 . S SC("STARTDT")=$P(SCCV0,U,3),SC("ENDDT")=$P(SCCV0,U,4)
21 . D CHKDT^SCCVU1(.SCRESULT,.SC,"CST") ;validate date
22 . Q:$G(SCRESULT)
23 . S SC("TYPE")=$P(SCCV0,U,2),SC("TEMPLNO")=SCCV
24 . D CHKDUP^SCCVU1(.SCRESULT,.SC,"CST")
25 . Q:$G(SCRESULT)
26 . W !!,"*** Template #",SCCV," has been added. [Date Range: ",$$FMTE^XLFDT(SC("STARTDT"),"5ZD")," - ",$$FMTE^XLFDT(SC("ENDDT"),"5ZD"),"]",!
27 . F S DIR(0)="SA^0:Estimate;1:Convert",DIR("A")="Event: ",DIR("B")="Estimate" D ^DIR K DIR Q:X'="" W !,*7,"This is a required field!!"
28 . I Y'?1N S SCRESULT="^'Event' is required ... Template entry deleted" Q
29 . K SC S SC(.05)=+Y
30 . D UPD^SCCVDBU(404.98,SCCV,.SC,.SCRESULT)
31 . Q:$P($G(SCRESULT),U,2)'=""
32 . S SCADD=1
33 I $P(SCRESULT,U,2)'="" D ERR(SCRESULT,SCCV) G:SCRESULT NEWQ
34 I $G(SCADD) D
35 .S DIR(0)="YA",DIR("A")="Do you want to schedule this event to run? ",DIR("B")="YES" D ^DIR K DIR
36 .I Y S SCCVDA=SCCV D REQ^SCCVCST1(0,$G(SCCVSCRN),1)
37 .D BLD^SCCVDSP("CST")
38NEWQ S VALMBCK="R"
39 Q
40 ;
41VIEW ; -- Expand conversion Template
42 N SCCVX,VALMY,SCCVDA
43 D SELX^SCCVDSP("CST")
44 I $G(SCCVDA) D EN^VALM("SCCV CONV EXPAND")
45 D BLD^SCCVDSP("CST")
46 S VALMBCK="R"
47 Q
48 ;
49ERR(SCRESULT,SCCV) ; -- Process error
50 N DA,DIR,DIK,X,Y
51 W !!,$P(SCRESULT,U,2),!
52 I SCCV S DIK="^SD(404.98,",DA=SCCV D ^DIK
53 S DIR(0)="EA",DIR("A")="Press RETURN to continue " S:$P(SCRESULT,U,2)="" DIR("A",1)="You have encountered an error" D ^DIR K DIR
54 Q
55 ;
Note: See TracBrowser for help on using the repository browser.