| [613] | 1 | RTP4 ;MJK/TROY ISC;Charge Out Pull List; ;7/15/96 18:02
|
|---|
| 2 | ;;v 2.0;Record Tracking;**3**;10/22/91
|
|---|
| 3 | 6 ;Charge Out Pull List
|
|---|
| 4 | S RTRD(1)="Yes^designate requests as 'not fillable'",RTRD(2)="No^not designate any requests as 'not fillable'",RTRD("B")=2,RTRD(0)="S",RTRD("A")="Do you wish to first designate some requests as 'not fillable'? "
|
|---|
| 5 | D SET^RTRD K RTRD Q:$E(X)="^" I $E(X)="Y" D 5^RTP1
|
|---|
| 6 | D DIV G Q:'$D(RTDV) S RTMES="CHARGED OUT" D PULL^RTP6 K RTMES G Q:'$D(RTPULL)
|
|---|
| 7 | ;ask holding area
|
|---|
| 8 | K RTB D BOR^RTP40 G Q:$D(RTESC) I $D(RTB) S RTHOLD=""
|
|---|
| 9 | ;ask for perpetual records if RR
|
|---|
| 10 | S (RTYES,RTACCN)=""
|
|---|
| 11 | I $D(RTHOLD)!('$D(RTIRE))
|
|---|
| 12 | E D BOR^RTP41 K DIC G Q:$S('$D(RTB):1,RTYES["^":1,RTACCN["^":1,1:0)
|
|---|
| 13 | ;
|
|---|
| 14 | I RTPULL="ALL" W !!?5,"*** Printing an 'UPDATE' listing maybe a good idea ***",!?5,"*** before charging out these records. ***"
|
|---|
| 15 | S RTRD(1)="Yes^continue charge out process",RTRD(2)="No^stop charge out process",RTRD("A")="Are you sure you want to 'CHARGE OUT' these records? ",RTRD("B")=2,RTRD(0)="S" D SET^RTRD K RTRD G Q:$E(X)'="Y"
|
|---|
| 16 | ;
|
|---|
| 17 | D NOW^%DTC S RTQUEDT=%,RTVAR="RTACCN^RTFR^RTYES^RTAPL^RTQUEDT^RTDT^RTDV^RTPULL"_$S($D(RTB):"^RTB",1:"")_$S($D(RTIRE):"^RTIRE",1:"")_$S($D(RTHOLD):"^RTHOLD",1:""),RTDESC="Charge Out Pull List",RTPGM="START^RTP4" D ZIS^RTUTL G Q:POP
|
|---|
| 18 | ;
|
|---|
| 19 | START U IO K ^TMP($J),RTP0 S RTBKGRD="",RTALL=+RTPULL,RTBEG=RTDT-.0001,RTEND=$S(RTDT[".":RTDT,1:RTDT_".2359") I $D(RTB),$D(RTHOLD) D ^RTP40 G Q
|
|---|
| 20 | I $D(RTB),$D(RTIRE) S ^TMP($J,"RTREQUESTS","RTB")=RTB K RTB
|
|---|
| 21 | S RTAG="SCAN" D CHK W @IOF F RTLIST="RTCANCEL","RTMISS" I $D(^TMP($J,RTLIST)) D LIST^RTP41
|
|---|
| 22 | W @IOF,!,"PULL LIST CHARGE-OUT LOG" D NOW^%DTC S Y=$E(%,1,12) D D^DIQ W ?51,"RUN DATE: ",Y D LINE^RTUTL3 W ! S RTAG="FILL" D CHK
|
|---|
| 23 | ;now go and make perpetual records
|
|---|
| 24 | I RTYES,$D(RTIRE),'$D(RTHOLD) D PERP^RTQ41
|
|---|
| 25 | ;
|
|---|
| 26 | Q K RTACCN,RTYES,RTHOLD,DIC,RTAG,DR,RTESC,RTBKGRD,RTPGM,RTPLTY,RTVAR,RTLIST,RTN,RTSSN,RTSTAT,SAVX,RTB,RTC,RTBEG,RTEND,RTDESC,RTALL,RTQUEDT,RTPULL,RTPULL0,RTDV,RTDT,RTDEV
|
|---|
| 27 | K ^TMP($J)
|
|---|
| 28 | D CLOSE^RTUTL K %DT,DA,D0,DIE,N,A
|
|---|
| 29 | K Y,RT,J,RTE,X1,P Q
|
|---|
| 30 | ;rtp0,"^",10 is pull list type
|
|---|
| 31 | CHK I 'RTALL F RTPDT=RTBEG:0 S RTPDT=$O(^RTV(194.2,"C",RTPDT)) Q:'RTPDT!(RTPDT>RTEND) F RTPULL=0:0 S RTPULL=$O(^RTV(194.2,"C",RTPDT,RTPULL)) Q:'RTPULL I $D(^RTV(194.2,RTPULL,0)) S RTP0=^(0) I "13"[$E($P(RTP0,"^",10)_"0") D CHKPULL D:Y @RTAG
|
|---|
| 32 | I $D(^RTV(194.2,+RTALL,0)) S RTPULL=+RTALL,RTP0=^(0) D CHKPULL D:Y @RTAG
|
|---|
| 33 | K RTPULL,RTP0,RTPDT Q
|
|---|
| 34 | ;^6 canceled, apl, div
|
|---|
| 35 | CHKPULL S Y=0,X=RTP0 Q:$S($P(X,"^",6)="x":1,$P(X,"^",15)'=+RTAPL:1,$P(X,"^",12)'=RTDV:1,1:0) S RTPLTY=$P(X,"^",10)
|
|---|
| 36 | I '$D(RTIRE),RTPLTY'=3 S Y=1 Q
|
|---|
| 37 | I $D(RTIRE),RTPLTY=3 S Y=1 Q
|
|---|
| 38 | Q
|
|---|
| 39 | SCAN F RTN=0:0 K RT S RTN=$O(^RTV(190.1,"AP",RTPULL,RTN)) Q:'RTN I $D(^RTV(190.1,RTN,0)) S RTQ=RTN,RTQ0=^(0),RT=+RTQ0 D SET
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | SET I $P(RTQ0,"^",6)="x" S ^TMP($J,"RTCANCEL",$P(RTP0,"^"),RTQ)=RTQ0 Q
|
|---|
| 43 | I $D(^RTV(190.2,"AM","m",RT))!($D(^RTV(190.2,"AM","s",RT))) S ^TMP($J,"RTMISS",$P(RTP0,"^"),RTQ)=RTQ0 Q
|
|---|
| 44 | S X=+$P(RTQ0,"^",4) Q:'X S:'$D(^TMP($J,"RTREQUESTS",RT)) ^(RT)=X_"^"_RTQ S:X<^(RT) ^(RT)=X_"^"_RTQ ;;;Q
|
|---|
| 45 | ;rte=^(0)^1
|
|---|
| 46 | I RTYES,$D(RTIRE),$D(RTPLTY),RTPLTY=3,$D(^RT(RT,0)) S X=$P(^(0),"^") I X]"",'$D(^TMP($J,"RTE",X)) S ^(X)="" Q
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | DIV ;Entry point to determine if pull function is allowed
|
|---|
| 50 | ; with RTAPL and RTDIV defined
|
|---|
| 51 | K RTDV,RTDEV I $S('$D(RTDIV):1,'$D(RTFR):1,'$D(^DIC(4,+RTDIV,0)):1,'$D(^DIC(195.1,+RTAPL,"INST",+RTDIV)):1,1:0) D MES Q
|
|---|
| 52 | W !!,"Institution: ",$P(^DIC(4,+RTDIV,0),"^") S RTDV=RTDIV,RTDEV=$P(RTFR,"^",6) Q
|
|---|
| 53 | ;
|
|---|
| 54 | MES W !!?3,*7,"This function requires the user to be signed onto the",!?3,"system with INSTITUTION parameters defined." Q
|
|---|
| 55 | ;
|
|---|
| 56 | FILL S RTCOMR="Pull List: "_$P(RTP0,"^") F RTQ=0:0 S RTQ=$O(^RTV(190.1,"AP",RTPULL,RTQ)) Q:'RTQ I $D(^RTV(190.1,RTQ,0)),$P(^(0),"^",6)="r" S RTQ0=^(0) D FILL1
|
|---|
| 57 | K RTQ,RTQ0,RTCOMR S RTSTAT="c" D STAT^RTP W !?3,"...'",$P(RTP0,"^"),"' pull list has been charged out." Q
|
|---|
| 58 | ;
|
|---|
| 59 | FILL1 Q:$S('$D(^RT(+RTQ0,"CL")):1,+$P(^("CL"),"^",6)>RTQUEDT:1,$P(RTQ0,"^",6)'="r":1,1:0) I $P(RTP0,"^",16),$P(^("CL"),"^",5)'=$P(RTP0,"^",16) Q
|
|---|
| 60 | S RT=+RTQ0 I $D(^TMP($J,"RTREQUESTS",RT)),$P(^(RT),"^",2)=RTQ D:RTPLTY'=3 FILL^RTQ4 D:RTPLTY=3 FILL^RTQ41
|
|---|
| 61 | K RT Q
|
|---|
