- RAWKL ;HISC/FPT AISC/MJK,RMO-Workload Reports ;12/27/00 11:00
- ;;5.0;Radiology/Nuclear Medicine;**26**;Mar 16, 1998
- ;
- I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX=""
- ; RAFL flags Tech Rpt and Camera Rpt
- SUM S X="-----------------" W !!,RATITLE," Workload Report:",!,X,$E(X,1,$L(RATITLE)) K RAFL1,^TMP($J)
- ASKSUM ;
- W ! K DIR S DIR(0)="Y",DIR("A")="Do you wish only the summary report",DIR("B")="NO",DIR("?")="Enter YES for a summary report or NO for a detailed report"
- D ^DIR K DIR I $D(DIRUT) D Q^RAWKL2 Q
- I RATITLE["Interpreting" D Q:RAPRIM=-1
- . S RAPRIM=$$PRI($P(RATITLE," ",2)) D:RAPRIM=-1 Q^RAWKL2
- . Q
- S:Y=0 RAFL1=""
- K DIROUT,DIRUT,DTOUT,DUOUT
- S X=$$DIVLOC^RAUTL7() I X D Q^RAWKL2 Q
- S A="" F S A=$O(RACCESS(DUZ,"DIV-IMG",A)) Q:A']"" D
- . Q:'$D(^TMP($J,"RA D-TYPE",A)) S A1=$O(^TMP($J,"RA D-TYPE",A,0))
- . Q:A1'>0 S B=""
- . F S B=$O(RACCESS(DUZ,"DIV-IMG",A,B)) Q:B']"" D
- .. I $D(^TMP($J,"RA I-TYPE",B)) D IT^RALWKL2 I B1?3AP1"-".N S ^TMP($J,"RAWKL",A1,B1)=0
- .. Q
- . Q
- K A,A1,B,B1,RACCESS(DUZ,"DIV-IMG")
- S RAINPUT=$$ALLNOTH^RALWKL3() I RAINPUT="" D Q^RAWKL2 Q
- I RAINPUT=0 D RSPTR I RAQUIT=1 D Q^RAWKL2 Q
- I RAINPUT=0 S RAFLDCNT=0,RALP="" F S RALP=$O(^TMP($J,"RAFLD",RALP)) Q:RALP="" S RAFLDCNT=RAFLDCNT+1
- K RALP
- D DATE^RAUTL I RAPOP D Q^RAWKL2 Q
- S RAXIT=0 D DISPXAM^RALWKL1(RACRT) I RAXIT D Q^RAWKL2 Q
- S ZTDESC="Rad/Nuc Med "_RATITLE_" Workload Report",ZTRTN="START^RAWKL" S ZTSAVE("RAFL*")="",ZTSAVE("^TMP($J,""RAWKL"",")="",ZTSAVE("^TMP($J,""RAFLD"",")=""
- F RASV="BEGDATE","ENDDATE","RAFILE","RAFLDCNT","RAPCE","RAPSTX","RATITLE","RACRT","RAINPUT","RAPRIM","RACMLIST" S ZTSAVE(RASV)=""
- W ! D ZIS^RAUTL I RAPOP D Q^RAWKL2 Q
- START ; start processing
- U IO K ^TMP($J,"RA") S:$D(ZTQUEUED) ZTREQ="@" K RAEOS
- S RABEG=BEGDATE-.0001,RAEND=ENDDATE+.9999,RA80DASH=$$REPEAT^XLFSTR("-",80)
- S Y=BEGDATE D D^RAUTL S BEGDATE=Y
- S Y=ENDDATE D D^RAUTL S ENDDATE=Y
- S X="NOW",%DT="T" D ^%DT K %DT D D^RAUTL S RARUNDTE=Y
- D CRIT^RAUTL1 S RACPT=""
- S RAITCNT=0,RALP=""
- F S RALP=$O(^TMP($J,"RAWKL",RALP)) Q:RALP="" S RAITCNT(RALP)=0,^TMP($J,"RA",RALP)="0^0^0" S RALP1="" F S RALP1=$O(^TMP($J,"RAWKL",RALP,RALP1)) Q:RALP1="" S RAITCNT(RALP)=RAITCNT(RALP)+1,^TMP($J,"RA",RALP,RALP1)="0^0^0"
- K RALP,RALP1
- F RADTE=RABEG:0:RAEND S RADTE=$O(^RADPT("AR",RADTE)) Q:RADTE'>0!(RADTE>RAEND)!($D(RAEOS)) S RADTI=9999999.9999-RADTE D RADFN^RAWKL1
- G:'$D(RAEOS) ^RAWKL2
- Q
- ;
- TECH S RAFILE="VA(200,",RACRT=7,RAPCE="TC",RATITLE="Technologist",RAFL="" G RAWKL
- ;
- RES N RAPRIM S RAFILE="VA(200,",RACRT=13,RAPCE=12,RATITLE="Interpreting Resident" G RAWKL
- ;
- STAFF N RAPRIM S RAFILE="VA(200,",RACRT=14,RAPCE=15,RATITLE="Interpreting Staff" D ASK1 I $D(DIRUT) D Q^RAWKL2 Q
- G RAWKL
- ;
- PHY S RAFILE="VA(200,",RACRT=12,RAPCE=14,RATITLE="Requesting M.D." G RAWKL
- ;
- ROOM S RAFILE="RA(78.6,",RACRT=11,RAPCE=18,RATITLE="Camera/Equip/Room",RAFL="" G RAWKL
- ;
- RSPTR ; select res/staff/phy/tech/room to include in workload rpts
- ; Creates ^TMP($J,"RAFLD",File 200 NAME)=""
- K ^TMP($J,"RAFLD")
- S RACNT=0
- ; check for one res/staff/tech only
- I RACRT=7!(RACRT=13)!(RACRT=14) S RASUBSPT=$S(RACRT=7:"T",RACRT=13:"R",RACRT=14:"S",1:""),RAONECHK=0 F S RAONECHK=$O(^VA(200,"ARC",RASUBSPT,RAONECHK)) Q:RAONECHK=""!(RACNT>1) S RACNT=RACNT+1
- I RACNT=1 D RST,KILL Q
- ; check for one physician only
- I RACRT=12 S RAONECHK=0 F S RAONECHK=$O(^XUSEC("PROVIDER",RAONECHK)) Q:RAONECHK=""!(RACNT>1) S RACNT=RACNT+1
- I RACNT=1 D P,KILL Q
- ; check for one camera room only
- I RACRT=11 S RAONECHK=$P(^RA(78.6,0),U,4) I RAONECHK=1 S RAIEN=$O(^RA(78.6,0)) Q:RAIEN<1 S RAONENME=$P(^RA(78.6,+RAIEN,0),U,1)_$P(^RA(78.6,+RAIEN,0),U,2),RAONENME=$E(RAONENME,1,30),^TMP($J,"RAFLD",RAONENME)="" D KILL Q
- I RACRT=7!(RACRT=13)!(RACRT=14)!(RACRT=12) S RADIC="^VA(200,"
- I RACRT=11 S RADIC="^RA(78.6,"
- S RADIC(0)="QEAMZ"
- S RADIC("A")="Select "_RATITLE_": "
- I RACRT=7 S RADIC("S")="I $D(^VA(200,""ARC"",""T"",+Y))"
- I RACRT=13 S RADIC("S")="I $D(^VA(200,""ARC"",""R"",+Y))"
- I RACRT=14 S RADIC("S")="I $D(^VA(200,""ARC"",""S"",+Y))"
- I RACRT=12 S RADIC("S")="I $D(^XUSEC(""PROVIDER"",+Y))"
- S RAUTIL="RAFLD"
- D EN1^RASELCT(.RADIC,RAUTIL,"",RAINPUT)
- KILL ;
- K %W,%Y1,DIC,RACNT,RADIC,RAIEN,RAONECHK,RAONENME,RASUBSPT,RAUTIL,X,Y
- Q
- RST ; resident/staff/tech
- S RAIEN=$O(^VA(200,"ARC",RASUBSPT,0)),RAONENME=$P(^VA(200,+RAIEN,0),U,1),RAONENME=$E(RAONENME,1,30),^TMP($J,"RAFLD",RAONENME)=""
- Q
- P ; physicians
- S RAIEN=$O(^XUSEC("PROVIDER",0)),RAONENME=$P(^VA(200,+RAIEN,0),U,1),RAONENME=$E(RAONENME,1,30),^TMP($J,"RAFLD",RAONENME)=""
- Q
- PRI(RACLS) ; Ask user to include Pri. Res/Staff only in the
- ; 'Interpreting Res/Staff' report
- ; Input: RACLS-> 'Resident' or 'Staff'
- ; Returns: 1 if Pri. Staff only, 0 if Pri. & Sec. Staff included, and
- ; -1 if exiting without a report
- W ! K DIR,DIROUT,DIRUT,DTOUT,DUOUT N X,Y
- S DIR(0)="Y",DIR("A")="Count "_RACLS_" when entered as 'secondary'"_$S(RACLS?1"S".E:" staff",1:" resident")_" interpreter",DIR("B")="Yes"
- S DIR("?",1)="Answer 'Yes' if both Primary and Secondary "_RACLS_" personnel will be included"
- S DIR("?",2)="in this report. Answer 'No' if only Primary "_RACLS_" personnel will be"
- S DIR("?")="included in this report. Input a '^' to exit without a report."
- D ^DIR S:$D(DIRUT) Y=-1 K DIR,DIROUT,DIRUT,DTOUT,DUOUT
- Q $S(+Y=-1:-1,+Y:0,1:1)
- ASK1 ; ask user if want to put CPT modifiers as separate line items
- K DIR S DIR(0)="Y",DIR("B")="NO"
- S DIR("A")="Do you want to count CPT Modifiers separately"
- S DIR("?")="Enter YES to put different combinations of CPT modifiers onto separate lines"
- W ! D ^DIR K DIR
- S:Y RACMLIST=1 ;=1 means to list CPT mods as separate line items
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAWKL 5727 printed Feb 19, 2025@00:06:56 Page 2
- RAWKL ;HISC/FPT AISC/MJK,RMO-Workload Reports ;12/27/00 11:00
- +1 ;;5.0;Radiology/Nuclear Medicine;**26**;Mar 16, 1998
- +2 ;
- +3 IF $ORDER(RACCESS(DUZ,""))=""
- DO SETVARS^RAPSET1(0)
- SET RAPSTX=""
- +4 ; RAFL flags Tech Rpt and Camera Rpt
- SUM SET X="-----------------"
- WRITE !!,RATITLE," Workload Report:",!,X,$EXTRACT(X,1,$LENGTH(RATITLE))
- KILL RAFL1,^TMP($JOB)
- ASKSUM ;
- +1 WRITE !
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Do you wish only the summary report"
- SET DIR("B")="NO"
- SET DIR("?")="Enter YES for a summary report or NO for a detailed report"
- +2 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- DO Q^RAWKL2
- QUIT
- +3 IF RATITLE["Interpreting"
- Begin DoDot:1
- +4 SET RAPRIM=$$PRI($PIECE(RATITLE," ",2))
- if RAPRIM=-1
- DO Q^RAWKL2
- +5 QUIT
- End DoDot:1
- if RAPRIM=-1
- QUIT
- +6 if Y=0
- SET RAFL1=""
- +7 KILL DIROUT,DIRUT,DTOUT,DUOUT
- +8 SET X=$$DIVLOC^RAUTL7()
- IF X
- DO Q^RAWKL2
- QUIT
- +9 SET A=""
- FOR
- SET A=$ORDER(RACCESS(DUZ,"DIV-IMG",A))
- if A']""
- QUIT
- Begin DoDot:1
- +10 if '$DATA(^TMP($JOB,"RA D-TYPE",A))
- QUIT
- SET A1=$ORDER(^TMP($JOB,"RA D-TYPE",A,0))
- +11 if A1'>0
- QUIT
- SET B=""
- +12 FOR
- SET B=$ORDER(RACCESS(DUZ,"DIV-IMG",A,B))
- if B']""
- QUIT
- Begin DoDot:2
- +13 IF $DATA(^TMP($JOB,"RA I-TYPE",B))
- DO IT^RALWKL2
- IF B1?3AP1"-".N
- SET ^TMP($JOB,"RAWKL",A1,B1)=0
- +14 QUIT
- End DoDot:2
- +15 QUIT
- End DoDot:1
- +16 KILL A,A1,B,B1,RACCESS(DUZ,"DIV-IMG")
- +17 SET RAINPUT=$$ALLNOTH^RALWKL3()
- IF RAINPUT=""
- DO Q^RAWKL2
- QUIT
- +18 IF RAINPUT=0
- DO RSPTR
- IF RAQUIT=1
- DO Q^RAWKL2
- QUIT
- +19 IF RAINPUT=0
- SET RAFLDCNT=0
- SET RALP=""
- FOR
- SET RALP=$ORDER(^TMP($JOB,"RAFLD",RALP))
- if RALP=""
- QUIT
- SET RAFLDCNT=RAFLDCNT+1
- +20 KILL RALP
- +21 DO DATE^RAUTL
- IF RAPOP
- DO Q^RAWKL2
- QUIT
- +22 SET RAXIT=0
- DO DISPXAM^RALWKL1(RACRT)
- IF RAXIT
- DO Q^RAWKL2
- QUIT
- +23 SET ZTDESC="Rad/Nuc Med "_RATITLE_" Workload Report"
- SET ZTRTN="START^RAWKL"
- SET ZTSAVE("RAFL*")=""
- SET ZTSAVE("^TMP($J,""RAWKL"",")=""
- SET ZTSAVE("^TMP($J,""RAFLD"",")=""
- +24 FOR RASV="BEGDATE","ENDDATE","RAFILE","RAFLDCNT","RAPCE","RAPSTX","RATITLE","RACRT","RAINPUT","RAPRIM","RACMLIST"
- SET ZTSAVE(RASV)=""
- +25 WRITE !
- DO ZIS^RAUTL
- IF RAPOP
- DO Q^RAWKL2
- QUIT
- START ; start processing
- +1 USE IO
- KILL ^TMP($JOB,"RA")
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- KILL RAEOS
- +2 SET RABEG=BEGDATE-.0001
- SET RAEND=ENDDATE+.9999
- SET RA80DASH=$$REPEAT^XLFSTR("-",80)
- +3 SET Y=BEGDATE
- DO D^RAUTL
- SET BEGDATE=Y
- +4 SET Y=ENDDATE
- DO D^RAUTL
- SET ENDDATE=Y
- +5 SET X="NOW"
- SET %DT="T"
- DO ^%DT
- KILL %DT
- DO D^RAUTL
- SET RARUNDTE=Y
- +6 DO CRIT^RAUTL1
- SET RACPT=""
- +7 SET RAITCNT=0
- SET RALP=""
- +8 FOR
- SET RALP=$ORDER(^TMP($JOB,"RAWKL",RALP))
- if RALP=""
- QUIT
- SET RAITCNT(RALP)=0
- SET ^TMP($JOB,"RA",RALP)="0^0^0"
- SET RALP1=""
- FOR
- SET RALP1=$ORDER(^TMP($JOB,"RAWKL",RALP,RALP1))
- if RALP1=""
- QUIT
- SET RAITCNT(RALP)=RAITCNT(RALP)+1
- SET ^TMP($JOB,"RA",RALP,RALP1)="0^0^0"
- +9 KILL RALP,RALP1
- +10 FOR RADTE=RABEG:0:RAEND
- SET RADTE=$ORDER(^RADPT("AR",RADTE))
- if RADTE'>0!(RADTE>RAEND)!($DATA(RAEOS))
- QUIT
- SET RADTI=9999999.9999-RADTE
- DO RADFN^RAWKL1
- +11 if '$DATA(RAEOS)
- GOTO ^RAWKL2
- +12 QUIT
- +13 ;
- TECH SET RAFILE="VA(200,"
- SET RACRT=7
- SET RAPCE="TC"
- SET RATITLE="Technologist"
- SET RAFL=""
- GOTO RAWKL
- +1 ;
- RES NEW RAPRIM
- SET RAFILE="VA(200,"
- SET RACRT=13
- SET RAPCE=12
- SET RATITLE="Interpreting Resident"
- GOTO RAWKL
- +1 ;
- STAFF NEW RAPRIM
- SET RAFILE="VA(200,"
- SET RACRT=14
- SET RAPCE=15
- SET RATITLE="Interpreting Staff"
- DO ASK1
- IF $DATA(DIRUT)
- DO Q^RAWKL2
- QUIT
- +1 GOTO RAWKL
- +2 ;
- PHY SET RAFILE="VA(200,"
- SET RACRT=12
- SET RAPCE=14
- SET RATITLE="Requesting M.D."
- GOTO RAWKL
- +1 ;
- ROOM SET RAFILE="RA(78.6,"
- SET RACRT=11
- SET RAPCE=18
- SET RATITLE="Camera/Equip/Room"
- SET RAFL=""
- GOTO RAWKL
- +1 ;
- RSPTR ; select res/staff/phy/tech/room to include in workload rpts
- +1 ; Creates ^TMP($J,"RAFLD",File 200 NAME)=""
- +2 KILL ^TMP($JOB,"RAFLD")
- +3 SET RACNT=0
- +4 ; check for one res/staff/tech only
- +5 IF RACRT=7!(RACRT=13)!(RACRT=14)
- SET RASUBSPT=$SELECT(RACRT=7:"T",RACRT=13:"R",RACRT=14:"S",1:"")
- SET RAONECHK=0
- FOR
- SET RAONECHK=$ORDER(^VA(200,"ARC",RASUBSPT,RAONECHK))
- if RAONECHK=""!(RACNT>1)
- QUIT
- SET RACNT=RACNT+1
- +6 IF RACNT=1
- DO RST
- DO KILL
- QUIT
- +7 ; check for one physician only
- +8 IF RACRT=12
- SET RAONECHK=0
- FOR
- SET RAONECHK=$ORDER(^XUSEC("PROVIDER",RAONECHK))
- if RAONECHK=""!(RACNT>1)
- QUIT
- SET RACNT=RACNT+1
- +9 IF RACNT=1
- DO P
- DO KILL
- QUIT
- +10 ; check for one camera room only
- +11 IF RACRT=11
- SET RAONECHK=$PIECE(^RA(78.6,0),U,4)
- IF RAONECHK=1
- SET RAIEN=$ORDER(^RA(78.6,0))
- if RAIEN<1
- QUIT
- SET RAONENME=$PIECE(^RA(78.6,+RAIEN,0),U,1)_$PIECE(^RA(78.6,+RAIEN,0),U,2)
- SET RAONENME=$EXTRACT(RAONENME,1,30)
- SET ^TMP($JOB,"RAFLD",RAONENME)=""
- DO KILL
- QUIT
- +12 IF RACRT=7!(RACRT=13)!(RACRT=14)!(RACRT=12)
- SET RADIC="^VA(200,"
- +13 IF RACRT=11
- SET RADIC="^RA(78.6,"
- +14 SET RADIC(0)="QEAMZ"
- +15 SET RADIC("A")="Select "_RATITLE_": "
- +16 IF RACRT=7
- SET RADIC("S")="I $D(^VA(200,""ARC"",""T"",+Y))"
- +17 IF RACRT=13
- SET RADIC("S")="I $D(^VA(200,""ARC"",""R"",+Y))"
- +18 IF RACRT=14
- SET RADIC("S")="I $D(^VA(200,""ARC"",""S"",+Y))"
- +19 IF RACRT=12
- SET RADIC("S")="I $D(^XUSEC(""PROVIDER"",+Y))"
- +20 SET RAUTIL="RAFLD"
- +21 DO EN1^RASELCT(.RADIC,RAUTIL,"",RAINPUT)
- KILL ;
- +1 KILL %W,%Y1,DIC,RACNT,RADIC,RAIEN,RAONECHK,RAONENME,RASUBSPT,RAUTIL,X,Y
- +2 QUIT
- RST ; resident/staff/tech
- +1 SET RAIEN=$ORDER(^VA(200,"ARC",RASUBSPT,0))
- SET RAONENME=$PIECE(^VA(200,+RAIEN,0),U,1)
- SET RAONENME=$EXTRACT(RAONENME,1,30)
- SET ^TMP($JOB,"RAFLD",RAONENME)=""
- +2 QUIT
- P ; physicians
- +1 SET RAIEN=$ORDER(^XUSEC("PROVIDER",0))
- SET RAONENME=$PIECE(^VA(200,+RAIEN,0),U,1)
- SET RAONENME=$EXTRACT(RAONENME,1,30)
- SET ^TMP($JOB,"RAFLD",RAONENME)=""
- +2 QUIT
- PRI(RACLS) ; Ask user to include Pri. Res/Staff only in the
- +1 ; 'Interpreting Res/Staff' report
- +2 ; Input: RACLS-> 'Resident' or 'Staff'
- +3 ; Returns: 1 if Pri. Staff only, 0 if Pri. & Sec. Staff included, and
- +4 ; -1 if exiting without a report
- +5 WRITE !
- KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
- NEW X,Y
- +6 SET DIR(0)="Y"
- SET DIR("A")="Count "_RACLS_" when entered as 'secondary'"_$SELECT(RACLS?1"S".E:" staff",1:" resident")_" interpreter"
- SET DIR("B")="Yes"
- +7 SET DIR("?",1)="Answer 'Yes' if both Primary and Secondary "_RACLS_" personnel will be included"
- +8 SET DIR("?",2)="in this report. Answer 'No' if only Primary "_RACLS_" personnel will be"
- +9 SET DIR("?")="included in this report. Input a '^' to exit without a report."
- +10 DO ^DIR
- if $DATA(DIRUT)
- SET Y=-1
- KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
- +11 QUIT $SELECT(+Y=-1:-1,+Y:0,1:1)
- ASK1 ; ask user if want to put CPT modifiers as separate line items
- +1 KILL DIR
- SET DIR(0)="Y"
- SET DIR("B")="NO"
- +2 SET DIR("A")="Do you want to count CPT Modifiers separately"
- +3 SET DIR("?")="Enter YES to put different combinations of CPT modifiers onto separate lines"
- +4 WRITE !
- DO ^DIR
- KILL DIR
- +5 ;=1 means to list CPT mods as separate line items
- if Y
- SET RACMLIST=1
- +6 QUIT