RMPROWL ;VACO/HNC- CLONE OWL SUSPENSE IN FILE 668 ;5/24/06
;;3.0;PROSTHETICS;**75**;Feb 09, 1996;Build 25
;
; Passed parameter DA - Prosthetics Consult Record from ^RMPR(668
;
; Passed parameter RMPRW - Work Order Number, external format
;
; Return RESULT(1)=ERROR STRING, OR Message ALL IS OKAY
Q
;
EN2(DA,RMPRW) ;Create OWL Clone in Suspense
G EN3
EN(RESULT,DA,RMPRW) ;GUI entry point
;
EN3 ;
N RMP9 S RMP9=$P($G(^RMPR(668,DA,0)),U,8)
I RMP9="" S RESULT(1)="No Suspense Available to Clone!" G EXIT
I (RMP9'=11) S RESULT(1)="Only LAB Can be CLONED" G EXIT
S RMPRH=DA
S (RMPRFLD,RMPRFI,RMPRFW)=0
D GETS^DIQ(668,RMPRH,"**","I","OUT")
Q:'$D(OUT)
;create new record
D NOW^%DTC S X=%
S DIC="^RMPR(668,",DIC(0)="L"
K DD,DO D FILE^DICN
S RMPRA=+Y
M R6681(668,RMPRA_",")=OUT(668,RMPRH_",")
F S RMPRFLD=$O(R6681(668,RMPRA_",",RMPRFLD)) Q:RMPRFLD'>0 D
. F S RMPRFI=$O(R6681(668,RMPRA_",",RMPRFLD,RMPRFI)) Q:RMPRFI="" D
.. I RMPRFI="I" S R668(668,RMPRA_",",RMPRFLD)=R6681(668,RMPRA_",",RMPRFLD,RMPRFI) Q
.. S R668(668,RMPRA_",",RMPRFLD,RMPRFI)=R6681(668,RMPRA_",",RMPRFLD,RMPRFI)
S RMPRC=RMPRA_","
S R668(668,RMPRA_",",4)="R668(668,"_""""_RMPRC_""""_",4)"
I $D(R668(668,RMPRA_",",7)) S R668(668,RMPRA_",",7)="R668(668,"_""""_RMPRC_""""_",7)"
K OUT
;
;don't set the following fields
K R668(668,RMPRA_",",.01)
;urgency
K R668(668,RMPRA_",",2.3)
;completion date
K R668(668,RMPRA_",",5)
;completed by
K R668(668,RMPRA_",",6)
;initial action note
K R668(668,RMPRA_",",7)
;suspended by
S R668(668,RMPRA_",",8)=DUZ
;patient 2319
K R668(668,RMPRA_",",8.1)
;amis grouper
K R668(668,RMPRA_",",8.2)
;init action date
K R668(668,RMPRA_",",10)
;completion note
K R668(668,RMPRA_",",12)
;initial action by
K R668(668,RMPRA_",",16)
;cancelled by
K R668(668,RMPRA_",",17)
;cancel date
K R668(668,RMPRA_",",18)
;CPRS order may be purged, remobe
K R668(668,RMPRA_",",19)
;cancel note
K R668(668,RMPRA_",",21)
;date rx written, keep same per Karen 9/15/03
;K R668(668,RMPRA_",",22)
;consult service
K R668(668,RMPRA_",",23)
;consult needed for display set to orig pointer
S R668(668,RMPRA_",",20)=$P(^RMPR(668,RMPRH,0),U,15)
;forwarded by
K R668(668,RMPRA_",",24)
;consult visit
K R668(668,RMPRA_",",30)
;set status to open
S R668(668,RMPRA_",",14)="O"
;set type to clone
S R668(668,RMPRA_",",9)=7
;will automatically set the Billing Fields as needed IF NO DUPLICATES!
;32,32.1,32.2,33,33.1,33.2,33.3
S DIC="^RMPR(668,",DIC(0)="AEQM"
D FILE^DIE("K","R668","ERROR")
I $D(ERROR) S RESULT(1)="COULD NOT CLONE DUE TO BAD DATA IN SUSPENSE!" D KILL
EXIT ;exit
K R6681,RMPRA,RMPRC,RMPRFLD,RMPRFI,RMPRFW,RMPRH
S RESULT(1)="New Clone Suspense Created."
Q
K DIC,DIK,ERROR,R668,X,Y
KILL ;get rid of new clone if error
S DA=RMPRA,DIK=668 D ^DIK
G EXIT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPROWL 2911 printed Apr 09, 2024@21:35:43 Page 2
RMPROWL ;VACO/HNC- CLONE OWL SUSPENSE IN FILE 668 ;5/24/06
+1 ;;3.0;PROSTHETICS;**75**;Feb 09, 1996;Build 25
+2 ;
+3 ; Passed parameter DA - Prosthetics Consult Record from ^RMPR(668
+4 ;
+5 ; Passed parameter RMPRW - Work Order Number, external format
+6 ;
+7 ; Return RESULT(1)=ERROR STRING, OR Message ALL IS OKAY
+8 QUIT
+9 ;
EN2(DA,RMPRW) ;Create OWL Clone in Suspense
+1 GOTO EN3
EN(RESULT,DA,RMPRW) ;GUI entry point
+1 ;
EN3 ;
+1 NEW RMP9
SET RMP9=$PIECE($GET(^RMPR(668,DA,0)),U,8)
+2 IF RMP9=""
SET RESULT(1)="No Suspense Available to Clone!"
GOTO EXIT
+3 IF (RMP9'=11)
SET RESULT(1)="Only LAB Can be CLONED"
GOTO EXIT
+4 SET RMPRH=DA
+5 SET (RMPRFLD,RMPRFI,RMPRFW)=0
+6 DO GETS^DIQ(668,RMPRH,"**","I","OUT")
+7 if '$DATA(OUT)
QUIT
+8 ;create new record
+9 DO NOW^%DTC
SET X=%
+10 SET DIC="^RMPR(668,"
SET DIC(0)="L"
+11 KILL DD,DO
DO FILE^DICN
+12 SET RMPRA=+Y
+13 MERGE R6681(668,RMPRA_",")=OUT(668,RMPRH_",")
+14 FOR
SET RMPRFLD=$ORDER(R6681(668,RMPRA_",",RMPRFLD))
if RMPRFLD'>0
QUIT
Begin DoDot:1
+15 FOR
SET RMPRFI=$ORDER(R6681(668,RMPRA_",",RMPRFLD,RMPRFI))
if RMPRFI=""
QUIT
Begin DoDot:2
+16 IF RMPRFI="I"
SET R668(668,RMPRA_",",RMPRFLD)=R6681(668,RMPRA_",",RMPRFLD,RMPRFI)
QUIT
+17 SET R668(668,RMPRA_",",RMPRFLD,RMPRFI)=R6681(668,RMPRA_",",RMPRFLD,RMPRFI)
End DoDot:2
End DoDot:1
+18 SET RMPRC=RMPRA_","
+19 SET R668(668,RMPRA_",",4)="R668(668,"_""""_RMPRC_""""_",4)"
+20 IF $DATA(R668(668,RMPRA_",",7))
SET R668(668,RMPRA_",",7)="R668(668,"_""""_RMPRC_""""_",7)"
+21 KILL OUT
+22 ;
+23 ;don't set the following fields
+24 KILL R668(668,RMPRA_",",.01)
+25 ;urgency
+26 KILL R668(668,RMPRA_",",2.3)
+27 ;completion date
+28 KILL R668(668,RMPRA_",",5)
+29 ;completed by
+30 KILL R668(668,RMPRA_",",6)
+31 ;initial action note
+32 KILL R668(668,RMPRA_",",7)
+33 ;suspended by
+34 SET R668(668,RMPRA_",",8)=DUZ
+35 ;patient 2319
+36 KILL R668(668,RMPRA_",",8.1)
+37 ;amis grouper
+38 KILL R668(668,RMPRA_",",8.2)
+39 ;init action date
+40 KILL R668(668,RMPRA_",",10)
+41 ;completion note
+42 KILL R668(668,RMPRA_",",12)
+43 ;initial action by
+44 KILL R668(668,RMPRA_",",16)
+45 ;cancelled by
+46 KILL R668(668,RMPRA_",",17)
+47 ;cancel date
+48 KILL R668(668,RMPRA_",",18)
+49 ;CPRS order may be purged, remobe
+50 KILL R668(668,RMPRA_",",19)
+51 ;cancel note
+52 KILL R668(668,RMPRA_",",21)
+53 ;date rx written, keep same per Karen 9/15/03
+54 ;K R668(668,RMPRA_",",22)
+55 ;consult service
+56 KILL R668(668,RMPRA_",",23)
+57 ;consult needed for display set to orig pointer
+58 SET R668(668,RMPRA_",",20)=$PIECE(^RMPR(668,RMPRH,0),U,15)
+59 ;forwarded by
+60 KILL R668(668,RMPRA_",",24)
+61 ;consult visit
+62 KILL R668(668,RMPRA_",",30)
+63 ;set status to open
+64 SET R668(668,RMPRA_",",14)="O"
+65 ;set type to clone
+66 SET R668(668,RMPRA_",",9)=7
+67 ;will automatically set the Billing Fields as needed IF NO DUPLICATES!
+68 ;32,32.1,32.2,33,33.1,33.2,33.3
+69 SET DIC="^RMPR(668,"
SET DIC(0)="AEQM"
+70 DO FILE^DIE("K","R668","ERROR")
+71 IF $DATA(ERROR)
SET RESULT(1)="COULD NOT CLONE DUE TO BAD DATA IN SUSPENSE!"
DO KILL
EXIT ;exit
+1 KILL R6681,RMPRA,RMPRC,RMPRFLD,RMPRFI,RMPRFW,RMPRH
+2 SET RESULT(1)="New Clone Suspense Created."
+3 QUIT
+4 KILL DIC,DIK,ERROR,R668,X,Y
KILL ;get rid of new clone if error
+1 SET DA=RMPRA
SET DIK=668
DO ^DIK
+2 GOTO EXIT
+3 QUIT
+4 ;
