- RMPR29GU ;HOIFO/SPS-CREATE 2529-3 GUI [ 10/17/05 8:55 AM ]
- ;;3.0;PROSTHETICS;**75,144**;Feb 09, 1996;Build 17
- ;
- A1(RMPRDA,RMPRSITE,RMPR668,RMPRPTR) ;
- D IN
- Q
- CR(RESULTS,RMPRDA,RMPRSITE,RMPR668,RMPRPTR) ;CREATE WORK ORDER
- IN D INF^RMPRSIT
- S SCR=$P(^RMPR(664.1,RMPRDA,0),U,11),RMERR=0
- K RMPRTMP I $P(^RMPR(664.1,RMPRDA,0),U,15)'=RMPR("STA") S RMPRTMP=1
- N DIC,Y,DIR S RMPRWO=1 D FQ^RMPRDT Q:'$D(RMPRFY)!('$D(RMPRQTR)) S:'$D(RMPRTMP) RMPRWO=$$STAN^RMPR31U(RMPR("STA"))_"-"_RMPRFY_"-"_RMPRQTR I $D(RMPRTMP) D
- .S RMPRWO=$$STAN^RMPR31U($P(^RMPR(664.1,RMPRDA,0),U,15))_"T-"_RMPRFY_"-"_RMPRQTR
- I '$D(^RMPR(669.1,"B",RMPRWO)) K DD,D0 S DIC="^RMPR(669.1,",DLAYGO=669.1,DIC(0)="LZ",X=RMPRWO D FILE^DICN K DLAYGO,D0
- S RDA=$O(^RMPR(669.1,"B",RMPRWO,0)) Q:'RDA
- L +^RMPR(669.1,RDA,0):1 I '$T S RESULTS(0)="1^Someone is editing this record!" G EXIT
- S RN=$P(^RMPR(669.1,RDA,0),U,2)+1 F I=1:1:4-$L(RN) S RN="0"_RN
- S RMPRWO=RMPRWO_"-"_SCR_"-"_RN
- S $P(^RMPR(669.1,RDA,0),U,2)=RN L -^RMPR(669.1,RDA,0)
- S $P(^RMPR(664.1,RMPRDA,0),U,13)=$G(RMPRWO)
- ;set no admin count/no lab count
- I $P(^RMPR(664.1,RMPRDA,0),U,15)=RMPR("STA")&($P(^(0),U,4)'=RMPR("STA")) S $P(^(0),U,23)=1
- I $P(^RMPR(664.1,RMPRDA,0),U,15)'=RMPR("STA") S $P(^(0),U,20)=1 S:$D(RMPR25) $P(^RMPR(664.1,RMPRDA,0),U,23)=1 S DIE="^RMPR(664.1,",DA=RMPRDA,DR="16///^S X=""PC""" D ^DIE
- I '$P(^RMPR(664.1,RMPRDA,0),U,20) S DIE="^RMPR(664.1,",DA=RMPRDA,DR="16///^S X=""P""" D ^DIE
- S RMDAT(664.1,RMPRDA_",",13)=DUZ
- S RMDAT(664.1,RMPRDA_",",17)=DT
- S RMDAT(664.1,RMPRDA_",",.05)=RMPR668
- D FILE^DIE("","RMDAT","RMERROR")
- I $D(RMERROR) S RMERR=1 D ERR G EXIT
- D IN5^VADPT S VAINDT=$P($G(VAIP(3)),U) D INP^VADPT
- I VAIN(1) S DR="12//^S X=$P(VAIN(4),U,2)" D ^DIE
- S RMSOP=$S($P(^RMPR(664.1,RMPRDA,0),U,11)="O":11,$P(^(0),U,11)="E":11,$P(^(0),U,11)="R":11,$P(^(0),U,11)="W":11,1:"")
- I +RMSOP>0 D G:RMERR=1 EXIT
- .L +^RMPR(668,RMPR668):2
- .I $T=0 S RESULTS(0)="1^Someone else is Editing this entry!" S RMERR=1 Q
- .S RMDAT(668,RMPR668_",",9)=RMSOP
- .D FILE^DIE("","RMDAT","RMERROR")
- .L -^RMPR(668,RMPR668)
- .I $D(RMERROR) S RMERR=1 D ERR Q
- D ^RMPR29GA
- S RESULTS(0)=0_"^"_"Work Order Created: "_RMPRWO
- ;ADD PRINT HERE.
- I RMPRPTR=0 D PRT^RMPR29R
- I +RMPRPTR D EN1^RMPR29R(RMPRPTR)
- Q
- ERR ;QUIT ON ERROR
- S RESULTS(0)="1^The following error has occured "_RMERROR
- Q
- EXIT ;
- K DA,DIE,DR,I,RDA,RMDAT,RMERR,RMERROR,RMPR,RMPR25,RMPRFY,RMPRQTR,RMPRWO
- K RMSOP,RN,SCR,VAIN,VAINDT,VAIP,X
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR29GU 2487 printed Mar 13, 2025@21:36:57 Page 2
- RMPR29GU ;HOIFO/SPS-CREATE 2529-3 GUI [ 10/17/05 8:55 AM ]
- +1 ;;3.0;PROSTHETICS;**75,144**;Feb 09, 1996;Build 17
- +2 ;
- A1(RMPRDA,RMPRSITE,RMPR668,RMPRPTR) ;
- +1 DO IN
- +2 QUIT
- CR(RESULTS,RMPRDA,RMPRSITE,RMPR668,RMPRPTR) ;CREATE WORK ORDER
- IN DO INF^RMPRSIT
- +1 SET SCR=$PIECE(^RMPR(664.1,RMPRDA,0),U,11)
- SET RMERR=0
- +2 KILL RMPRTMP
- IF $PIECE(^RMPR(664.1,RMPRDA,0),U,15)'=RMPR("STA")
- SET RMPRTMP=1
- +3 NEW DIC,Y,DIR
- SET RMPRWO=1
- DO FQ^RMPRDT
- if '$DATA(RMPRFY)!('$DATA(RMPRQTR))
- QUIT
- if '$DATA(RMPRTMP)
- SET RMPRWO=$$STAN^RMPR31U(RMPR("STA"))_"-"_RMPRFY_"-"_RMPRQTR
- IF $DATA(RMPRTMP)
- Begin DoDot:1
- +4 SET RMPRWO=$$STAN^RMPR31U($PIECE(^RMPR(664.1,RMPRDA,0),U,15))_"T-"_RMPRFY_"-"_RMPRQTR
- End DoDot:1
- +5 IF '$DATA(^RMPR(669.1,"B",RMPRWO))
- KILL DD,D0
- SET DIC="^RMPR(669.1,"
- SET DLAYGO=669.1
- SET DIC(0)="LZ"
- SET X=RMPRWO
- DO FILE^DICN
- KILL DLAYGO,D0
- +6 SET RDA=$ORDER(^RMPR(669.1,"B",RMPRWO,0))
- if 'RDA
- QUIT
- +7 LOCK +^RMPR(669.1,RDA,0):1
- IF '$TEST
- SET RESULTS(0)="1^Someone is editing this record!"
- GOTO EXIT
- +8 SET RN=$PIECE(^RMPR(669.1,RDA,0),U,2)+1
- FOR I=1:1:4-$LENGTH(RN)
- SET RN="0"_RN
- +9 SET RMPRWO=RMPRWO_"-"_SCR_"-"_RN
- +10 SET $PIECE(^RMPR(669.1,RDA,0),U,2)=RN
- LOCK -^RMPR(669.1,RDA,0)
- +11 SET $PIECE(^RMPR(664.1,RMPRDA,0),U,13)=$GET(RMPRWO)
- +12 ;set no admin count/no lab count
- +13 IF $PIECE(^RMPR(664.1,RMPRDA,0),U,15)=RMPR("STA")&($PIECE(^(0),U,4)'=RMPR("STA"))
- SET $PIECE(^(0),U,23)=1
- +14 IF $PIECE(^RMPR(664.1,RMPRDA,0),U,15)'=RMPR("STA")
- SET $PIECE(^(0),U,20)=1
- if $DATA(RMPR25)
- SET $PIECE(^RMPR(664.1,RMPRDA,0),U,23)=1
- SET DIE="^RMPR(664.1,"
- SET DA=RMPRDA
- SET DR="16///^S X=""PC"""
- DO ^DIE
- +15 IF '$PIECE(^RMPR(664.1,RMPRDA,0),U,20)
- SET DIE="^RMPR(664.1,"
- SET DA=RMPRDA
- SET DR="16///^S X=""P"""
- DO ^DIE
- +16 SET RMDAT(664.1,RMPRDA_",",13)=DUZ
- +17 SET RMDAT(664.1,RMPRDA_",",17)=DT
- +18 SET RMDAT(664.1,RMPRDA_",",.05)=RMPR668
- +19 DO FILE^DIE("","RMDAT","RMERROR")
- +20 IF $DATA(RMERROR)
- SET RMERR=1
- DO ERR
- GOTO EXIT
- +21 DO IN5^VADPT
- SET VAINDT=$PIECE($GET(VAIP(3)),U)
- DO INP^VADPT
- +22 IF VAIN(1)
- SET DR="12//^S X=$P(VAIN(4),U,2)"
- DO ^DIE
- +23 SET RMSOP=$SELECT($PIECE(^RMPR(664.1,RMPRDA,0),U,11)="O":11,$PIECE(^(0),U,11)="E":11,$PIECE(^(0),U,11)="R":11,$PIECE(^(0),U,11)="W":11,1:"")
- +24 IF +RMSOP>0
- Begin DoDot:1
- +25 LOCK +^RMPR(668,RMPR668):2
- +26 IF $TEST=0
- SET RESULTS(0)="1^Someone else is Editing this entry!"
- SET RMERR=1
- QUIT
- +27 SET RMDAT(668,RMPR668_",",9)=RMSOP
- +28 DO FILE^DIE("","RMDAT","RMERROR")
- +29 LOCK -^RMPR(668,RMPR668)
- +30 IF $DATA(RMERROR)
- SET RMERR=1
- DO ERR
- QUIT
- End DoDot:1
- if RMERR=1
- GOTO EXIT
- +31 DO ^RMPR29GA
- +32 SET RESULTS(0)=0_"^"_"Work Order Created: "_RMPRWO
- +33 ;ADD PRINT HERE.
- +34 IF RMPRPTR=0
- DO PRT^RMPR29R
- +35 IF +RMPRPTR
- DO EN1^RMPR29R(RMPRPTR)
- +36 QUIT
- ERR ;QUIT ON ERROR
- +1 SET RESULTS(0)="1^The following error has occured "_RMERROR
- +2 QUIT
- EXIT ;
- +1 KILL DA,DIE,DR,I,RDA,RMDAT,RMERR,RMERROR,RMPR,RMPR25,RMPRFY,RMPRQTR,RMPRWO
- +2 KILL RMSOP,RN,SCR,VAIN,VAINDT,VAIP,X
- +3 QUIT
