SD53P541 ;ALB/RLC - POST-INIT TO CORRECT PURPOSE OF VISIT FIELD; 7/27/07
;;5.3;SCHEDULING;**541**;21-MAR-94;Build 4
;
; LOOP THROUGH PATIENT FILE (2), APPOINTMENT MULTIPLE
; PURPOSE OF VISIT FIELD, FOR ALL APPOINTMENTS THAT
; CONTAIN AN INVALID VALUE IN THAT FIELD AND CHANGE
; THE VALUE IN EACH OCCURRANCE TO A VALUE OF 3.
;
; ONLY VALID VALUES ARE:
;
; 2.98,9 PURPOSE OF VISIT 0;7 SET (Required)
;
; '1' FOR C&P;
; '2' FOR 10-10;
; '3' FOR SCHEDULED VISIT;
; '4' FOR UNSCHED. VISIT;
;
;
Q ; must call at entry point
;
EN ;
S (DFN,TOTAL)=0,SDPURP=""
F S DFN=$O(^DPT(DFN)) Q:'DFN D
. S SDIEN=0
. F S SDIEN=$O(^DPT(DFN,"S",SDIEN)) Q:'SDIEN D
..Q:'$D(^DPT(DFN,"S",SDIEN,0))
..S SDPURP=$P($G(^DPT(DFN,"S",SDIEN,0)),"^",7) D
...Q:SDPURP>0&(SDPURP<5)
...S $P(^DPT(DFN,"S",SDIEN,0),"^",7)=3
...S TOTAL=TOTAL+1
D MSG
K DFN,SDIEN,SDPURP,TOTAL,XMDUZ,XMSUB,XMY,XMTEXT,DVPARAM,CT,MSGTXT
Q
;
MSG ;Send message containing total number of records updated
S (DVPARAM,XMDUZ,XMSUB,XMTEXT,XMY)="",CT=0 K MSGTXT
I 'TOTAL D NONE,MSG1 Q
S CT=CT+1,MSGTXT(CT)="TOTAL NUMBER OF RECORDS UPDATED: "_TOTAL
MSG1 S XMTEXT="MSGTXT"
S DVPARAM("FROM")="PATCH SD*5.3*541"
S XMDUZ=DUZ,XMSUB="UPDATE PURPOSE OF VISIT FROM INVALID VALUE TO 3"
S XMY(DUZ)=""
D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.DVPARAM,"","")
Q
;
NONE ;No records found with invalid value in Purpose of Visit field
S CT=CT+1,MSGTXT(CT)="No appointment records were found that contain an invalid"
S CT=CT+1,MSGTXT(CT)="value in the Purpose of Visit field in the Patient file."
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53P541 1716 printed Nov 22, 2024@17:56:26 Page 2
SD53P541 ;ALB/RLC - POST-INIT TO CORRECT PURPOSE OF VISIT FIELD; 7/27/07
+1 ;;5.3;SCHEDULING;**541**;21-MAR-94;Build 4
+2 ;
+3 ; LOOP THROUGH PATIENT FILE (2), APPOINTMENT MULTIPLE
+4 ; PURPOSE OF VISIT FIELD, FOR ALL APPOINTMENTS THAT
+5 ; CONTAIN AN INVALID VALUE IN THAT FIELD AND CHANGE
+6 ; THE VALUE IN EACH OCCURRANCE TO A VALUE OF 3.
+7 ;
+8 ; ONLY VALID VALUES ARE:
+9 ;
+10 ; 2.98,9 PURPOSE OF VISIT 0;7 SET (Required)
+11 ;
+12 ; '1' FOR C&P;
+13 ; '2' FOR 10-10;
+14 ; '3' FOR SCHEDULED VISIT;
+15 ; '4' FOR UNSCHED. VISIT;
+16 ;
+17 ;
+18 ; must call at entry point
QUIT
+19 ;
EN ;
+1 SET (DFN,TOTAL)=0
SET SDPURP=""
+2 FOR
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
Begin DoDot:1
+3 SET SDIEN=0
+4 FOR
SET SDIEN=$ORDER(^DPT(DFN,"S",SDIEN))
if 'SDIEN
QUIT
Begin DoDot:2
+5 if '$DATA(^DPT(DFN,"S",SDIEN,0))
QUIT
+6 SET SDPURP=$PIECE($GET(^DPT(DFN,"S",SDIEN,0)),"^",7)
Begin DoDot:3
+7 if SDPURP>0&(SDPURP<5)
QUIT
+8 SET $PIECE(^DPT(DFN,"S",SDIEN,0),"^",7)=3
+9 SET TOTAL=TOTAL+1
End DoDot:3
End DoDot:2
End DoDot:1
+10 DO MSG
+11 KILL DFN,SDIEN,SDPURP,TOTAL,XMDUZ,XMSUB,XMY,XMTEXT,DVPARAM,CT,MSGTXT
+12 QUIT
+13 ;
MSG ;Send message containing total number of records updated
+1 SET (DVPARAM,XMDUZ,XMSUB,XMTEXT,XMY)=""
SET CT=0
KILL MSGTXT
+2 IF 'TOTAL
DO NONE
DO MSG1
QUIT
+3 SET CT=CT+1
SET MSGTXT(CT)="TOTAL NUMBER OF RECORDS UPDATED: "_TOTAL
MSG1 SET XMTEXT="MSGTXT"
+1 SET DVPARAM("FROM")="PATCH SD*5.3*541"
+2 SET XMDUZ=DUZ
SET XMSUB="UPDATE PURPOSE OF VISIT FROM INVALID VALUE TO 3"
+3 SET XMY(DUZ)=""
+4 DO SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.DVPARAM,"","")
+5 QUIT
+6 ;
NONE ;No records found with invalid value in Purpose of Visit field
+1 SET CT=CT+1
SET MSGTXT(CT)="No appointment records were found that contain an invalid"
+2 SET CT=CT+1
SET MSGTXT(CT)="value in the Purpose of Visit field in the Patient file."
+3 QUIT
+4 ;
