- PRSAEDS ; HISC/REL-Display Envir. Diff. Request ;6/10/93 14:33
- ;;4.0;PAID;**114**;Sep 21, 1995;Build 6
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- DISP ; Display Envir. Diff. Requests
- S EDS=";"_$P(^DD(458.3,8,0),"^",3),CNT=0 K:NUM R
- F DTI=0:0 S DTI=$O(^PRST(458.3,"AD",DFN,DTI)) Q:DTI=""!(DTI>EDT) F DA=0:0 S DA=$O(^PRST(458.3,"AD",DFN,DTI,DA)) Q:DA="" D LST
- W:'CNT !,"No Requests on File." Q
- LST ; Display Request
- S Z=$G(^PRST(458.3,DA,0)) Q:Z="" S SCOM=$P($G(^(1)),"^",1) I NUM,$P(Z,"^",9)'="R" Q
- S CNT=CNT+1 W ! I NUM W $J(CNT,2)," " S R(CNT)=DA
- S X=$P(Z,"^",3) D DTP^PRSAPPU W Y," ",$P(Z,"^",4),"-",$P(Z,"^",6)," (Meal: ",+$P(Z,"^",5),") "
- S X=$P(Z,"^",7)
- W $P($G(^PRST(457.6,+X,0)),"^",1)," Envir. Diff. "
- S X=$P(Z,"^",9)
- S %=$F(EDS,";"_X_":") I %>0 W $P($E(EDS,%,999),";",1)
- S X=$P(Z,"^",8) W:X'="" !?5,X W:SCOM'="" !?5,"Supr: ",SCOM Q
- HDR ; Display Header
- W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM",!?22,"ENVIRONMENTAL DIFFERENTIAL REQUESTS"
- S X=$G(^PRSPC(DFN,0)) W !!,$P(X,"^",1) S X=$P(X,"^",9) I X W ?67,$E(X),"XX-XX-",$E(X,6,9) Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSAEDS 1125 printed Feb 18, 2025@23:49:50 Page 2
- PRSAEDS ; HISC/REL-Display Envir. Diff. Request ;6/10/93 14:33
- +1 ;;4.0;PAID;**114**;Sep 21, 1995;Build 6
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- DISP ; Display Envir. Diff. Requests
- +1 SET EDS=";"_$PIECE(^DD(458.3,8,0),"^",3)
- SET CNT=0
- if NUM
- KILL R
- +2 FOR DTI=0:0
- SET DTI=$ORDER(^PRST(458.3,"AD",DFN,DTI))
- if DTI=""!(DTI>EDT)
- QUIT
- FOR DA=0:0
- SET DA=$ORDER(^PRST(458.3,"AD",DFN,DTI,DA))
- if DA=""
- QUIT
- DO LST
- +3 if 'CNT
- WRITE !,"No Requests on File."
- QUIT
- LST ; Display Request
- +1 SET Z=$GET(^PRST(458.3,DA,0))
- if Z=""
- QUIT
- SET SCOM=$PIECE($GET(^(1)),"^",1)
- IF NUM
- IF $PIECE(Z,"^",9)'="R"
- QUIT
- +2 SET CNT=CNT+1
- WRITE !
- IF NUM
- WRITE $JUSTIFY(CNT,2)," "
- SET R(CNT)=DA
- +3 SET X=$PIECE(Z,"^",3)
- DO DTP^PRSAPPU
- WRITE Y," ",$PIECE(Z,"^",4),"-",$PIECE(Z,"^",6)," (Meal: ",+$PIECE(Z,"^",5),") "
- +4 SET X=$PIECE(Z,"^",7)
- +5 WRITE $PIECE($GET(^PRST(457.6,+X,0)),"^",1)," Envir. Diff. "
- +6 SET X=$PIECE(Z,"^",9)
- +7 SET %=$FIND(EDS,";"_X_":")
- IF %>0
- WRITE $PIECE($EXTRACT(EDS,%,999),";",1)
- +8 SET X=$PIECE(Z,"^",8)
- if X'=""
- WRITE !?5,X
- if SCOM'=""
- WRITE !?5,"Supr: ",SCOM
- QUIT
- HDR ; Display Header
- +1 if $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- WRITE !?26,"VA TIME & ATTENDANCE SYSTEM",!?22,"ENVIRONMENTAL DIFFERENTIAL REQUESTS"
- +2 SET X=$GET(^PRSPC(DFN,0))
- WRITE !!,$PIECE(X,"^",1)
- SET X=$PIECE(X,"^",9)
- IF X
- WRITE ?67,$EXTRACT(X),"XX-XX-",$EXTRACT(X,6,9)
- QUIT