- PSAVSN ;BHM/DAV - Check for and reduce size of VSN node ;10/9/97
- ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**37**; 10/24/97
- S PSACTRL=0
- 1 S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) G DONE:PSACTRL'>0 S PSALINE=0
- PSAP31 ;entry point from PSAUP5
- 2 S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) G WHERE:PSALINE'>0
- S PSADATA=$G(^XTMP("PSAPV",PSACTRL,"IT",PSALINE))
- S PSAP31=$P($G(PSADATA),"^",5) I $L(PSAP31)'>25 G 2
- S CNT=0,PSAP31A=$P(PSAP31,"~~",2) F X=3:1 Q:$P(PSAP31,"~~",X)="" S PSAP31B=$P(PSAP31,"~~",X) I $G(PSAP31B)=PSAP31A S $P(PSAP31,"~~",X)=""
- S PSAP31D=$L(PSAP31) F X=PSAP31D:-1 S X1=$E(PSAP31,X) Q:X1'="~" S PSAP31=$E(PSAP31,1,(X-1))
- G 2
- DONE K PSALINE,PSAP31,PSAP31A,PSAP31B,PSAP31C,PSAP31D,CNT S X="PSAP31" X ^%ZOSF("DEL") Q
- WHERE ;Doing actual upload or Post PSA*3*31 utility
- I $G(PSAUPLD)'=1 G 1
- G DONE
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAVSN 844 printed Jan 18, 2025@02:52:29 Page 2
- PSAVSN ;BHM/DAV - Check for and reduce size of VSN node ;10/9/97
- +1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**37**; 10/24/97
- +2 SET PSACTRL=0
- 1 SET PSACTRL=$ORDER(^XTMP("PSAPV",PSACTRL))
- if PSACTRL'>0
- GOTO DONE
- SET PSALINE=0
- PSAP31 ;entry point from PSAUP5
- 2 SET PSALINE=$ORDER(^XTMP("PSAPV",PSACTRL,"IT",PSALINE))
- if PSALINE'>0
- GOTO WHERE
- +1 SET PSADATA=$GET(^XTMP("PSAPV",PSACTRL,"IT",PSALINE))
- +2 SET PSAP31=$PIECE($GET(PSADATA),"^",5)
- IF $LENGTH(PSAP31)'>25
- GOTO 2
- +3 SET CNT=0
- SET PSAP31A=$PIECE(PSAP31,"~~",2)
- FOR X=3:1
- if $PIECE(PSAP31,"~~",X)=""
- QUIT
- SET PSAP31B=$PIECE(PSAP31,"~~",X)
- IF $GET(PSAP31B)=PSAP31A
- SET $PIECE(PSAP31,"~~",X)=""
- +4 SET PSAP31D=$LENGTH(PSAP31)
- FOR X=PSAP31D:-1
- SET X1=$EXTRACT(PSAP31,X)
- if X1'="~"
- QUIT
- SET PSAP31=$EXTRACT(PSAP31,1,(X-1))
- +5 GOTO 2
- DONE KILL PSALINE,PSAP31,PSAP31A,PSAP31B,PSAP31C,PSAP31D,CNT
- SET X="PSAP31"
- XECUTE ^%ZOSF("DEL")
- QUIT
- WHERE ;Doing actual upload or Post PSA*3*31 utility
- +1 IF $GET(PSAUPLD)'=1
- GOTO 1
- +2 GOTO DONE