source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCAPMC20.m@ 1141

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1SCAPMC20 ;ALB/REW - Team APIs:APPTTM ; 20 Mar 1996
2 ;;5.3;Scheduling;**41**;AUG 13, 1993
3 ;;1.0
4ACOUTPT(DFN,SCFIELDA,SCERR) ;add/edit a record in OUTPATIENT PROFILE #404.41
5 ; input:
6 ; DFN = pointer to PATIENT file (#2)
7 ; SCFIELDA= array of additional fields to be added
8 ; SCERR = array NAME to store error messages.
9 ; [ex. ^TMP("ORXX",$J)]
10 ;
11 ; Output:
12 ; Returned = ok?^404.41 ien^new?
13 ; SCERR() = Array of DIALOG file messages(errors) .
14 ; Foramt:
15 ; Subscript: Sequential # from 1 to n
16 ; Piece Description
17 ; 1 IEN of DIALOG file
18 N SCEXIST
19 N SCESEQ,SCPARM,SCIEN,SC,SCFLD
20 G:'$$OKDATA APTTMQ ;check/setup variables
21 S SCEXIST=$D(^SCPT(404.41,DFN,0))#2
22 IF SCEXIST D
23 .IF $D(SCFIELDA) D
24 ..S SCFLD=0
25 ..F S SCFLD=$O(@SCFIELDA@(SCFLD)) Q:'SCFLD D
26 ...S SC($J,404.41,(+DFN)_",",SCFLD)=@SCFIELDA@(SCFLD)
27 .D FILE^DIE("E","SC($J)",SCERR)
28 ELSE D
29 .S SCIEN(1)=DFN
30 .S SC($J,404.41,"+1,",.01)="`"_DFN
31 .IF $D(SCFIELDA) D
32 ..S SCFLD=0
33 ..F S SCFLD=$O(@SCFIELDA@(SCFLD)) Q:'SCFLD D
34 ...S SC($J,404.41,"+1,",SCFLD)=@SCFIELDA@(SCFLD)
35 .D UPDATE^DIE("E","SC($J)","SCIEN",SCERR)
36 .IF $D(@SCERR)!($G(SCIEN(1))'=DFN) S @SCERR=1 K SCIEN
37 .ELSE D
38 ..S SCEXIST=0
39APTTMQ Q '$D(@SCERR@(0))_U_+$G(DFN)_U_'$G(SCEXIST)
40 ;
41OKDATA() ;setup/check variables
42 N SCOK
43 S SCOK=1
44 D INIT^SCAPMCU1(.SCOK)
45 IF '$D(^DPT(DFN,0)) D S SCOK=0
46 . S SCPARM("PATIENT")=DFN
47 . D ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
48 Q SCOK
49 ;
50MAKEMANY(DFNA,SCOLDASS,SCBADASS,SCNEWASS) ;Not supported for use by PCMM Only
51 ; DFNA - DFN ARRAY
52 ; SCOLDASS - Subset of DFNA that were previously assigned
53 ; SCBADASS - Subset of DFNA that could not be assigned
54 ; SCNEWASS - Subset of DFNA that were newly assigned
55 ; Return: total^new^old^bad
56 ; Note: No input error checking!!
57 N DFN,SCX,SCOUTFLD,SCBADOUT,SCBADCNT,SCNEWCND,SCOLDCNT
58 S (SCBADCNT,SCNEWCNT,SCOLDCNT)=0
59 S DFN=0
60 F S DFN=$O(@DFNA@(DFN)) Q:'DFN D
61 .S SCOUTFLD(.04)=1
62 .S SCX=$$ACOUTPT(DFN,"SCOUTFLD","SCBADOUT")
63 .IF 'SCX D
64 ..S @SCBADASS@(DFN)=""
65 ..S SCBADCNT=SCBADCNT+1
66 .ELSE D
67 ..IF $P(SCX,U,3) D
68 ...S @SCNEWASS@(DFN)=""
69 ...S SCNEWCNT=SCNEWCNT+1
70 ..ELSE D
71 ...S @SCOLDASS@(DFN)=""
72 ...S SCOLDCNT=SCOLDCNT+1
73 Q (SCOLDCNT+SCNEWCNT)_U_SCNEWCNT_U_SCOLDCNT_U_SCBADCNT
74 ;
75PTPCNOTM(SCOUTA,SCDATE) ;Not Supported For Use by PCMM Only
76 ; SCOUTA - Output array of DFNs that are PC but no Team Now
77 N DFN,SCPC
78 S DFN=0
79 F S DFN=$O(^SCPT(404.41,"APC",DFN)) Q:'DFN S SCPC=$O(^(DFN)) Q:'SCPC D
80 .Q:$D(^TMP("SCMC",$J,"EXCLUDE PT","SCPTA",+DFN))
81 .S:'$$GETPCTM^SCAPMCU2(DFN,SCDATE,1) @SCOUTA@(DFN)=DFN_U_$P($G(^DPT(DFN,0)),U,1)
82 Q
Note: See TracBrowser for help on using the repository browser.