- ACHSYPQM ; IHS/ITSC/PMF - MOVE OLD PRINT QUEUE ; [ 10/16/2001 8:16 AM ]
- ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
- ;
- ; In version of CHS prior to 1.6, the document print queue was kept
- ; in the ^%ZTSK global. This utility move the queue from the ^%ZTSK
- ; global to the new location at ^ACHSF("PQ".
- ;
- ; This was part of the post-init for version 1.6 and 2.0.
- ;
- ; You probably don't need to run this, but it can't hurt.
- ;
- W !,$$C^XBFUNC("Checking old document print q.")
- X ^%ZOSF("UCI")
- I '$D(^%ZTSK(Y,"ACHQ")) W !,$$C^XBFUNC("Nothing there. Previously converted.") G END2
- W !,$$C^XBFUNC("Transferring Document print Q from %ZTSK to ACHSF('PQ')")
- ;
- ; L=Location, S=TypeOfSvc, D=DocIEN, T=TransIEN
- ;
- S L=""
- L1 ;
- S L=$O(^%ZTSK(Y,"ACHQ",L))
- G END1:L=""
- S S=""
- L2 ;
- S S=$O(^%ZTSK(Y,"ACHQ",L,S))
- G L1:S=""
- S %=""
- L3 ;
- S %=$O(^%ZTSK(Y,"ACHQ",L,S,%))
- G L2:%=""
- S D=$P(^%ZTSK(Y,"ACHQ",L,S,%),U),T=$P(^(%),U,2),^ACHSF("PQ",L,S,D,T)=""
- W "."
- G L3
- END1 ;
- W !,$$C^XBFUNC("Print Q Transferred.")
- K ^%ZTSK(Y) ; Old global node
- END2 ;
- K L,D,T,S,Y
- K ^TMP("ACHSYPQM",$J)
- Q
- ;
- ACHSYPQM ; IHS/ITSC/PMF - MOVE OLD PRINT QUEUE ; [ 10/16/2001 8:16 AM ]
- +1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
- +2 ;
- +3 ; In version of CHS prior to 1.6, the document print queue was kept
- +4 ; in the ^%ZTSK global. This utility move the queue from the ^%ZTSK
- +5 ; global to the new location at ^ACHSF("PQ".
- +6 ;
- +7 ; This was part of the post-init for version 1.6 and 2.0.
- +8 ;
- +9 ; You probably don't need to run this, but it can't hurt.
- +10 ;
- +11 WRITE !,$$C^XBFUNC("Checking old document print q.")
- +12 XECUTE ^%ZOSF("UCI")
- +13 IF '$DATA(^%ZTSK(Y,"ACHQ"))
- WRITE !,$$C^XBFUNC("Nothing there. Previously converted.")
- GOTO END2
- +14 WRITE !,$$C^XBFUNC("Transferring Document print Q from %ZTSK to ACHSF('PQ')")
- +15 ;
- +16 ; L=Location, S=TypeOfSvc, D=DocIEN, T=TransIEN
- +17 ;
- +18 SET L=""
- L1 ;
- +1 SET L=$ORDER(^%ZTSK(Y,"ACHQ",L))
- +2 IF L=""
- GOTO END1
- +3 SET S=""
- L2 ;
- +1 SET S=$ORDER(^%ZTSK(Y,"ACHQ",L,S))
- +2 IF S=""
- GOTO L1
- +3 SET %=""
- L3 ;
- +1 SET %=$ORDER(^%ZTSK(Y,"ACHQ",L,S,%))
- +2 IF %=""
- GOTO L2
- +3 SET D=$PIECE(^%ZTSK(Y,"ACHQ",L,S,%),U)
- SET T=$PIECE(^(%),U,2)
- SET ^ACHSF("PQ",L,S,D,T)=""
- +4 WRITE "."
- +5 GOTO L3
- END1 ;
- +1 WRITE !,$$C^XBFUNC("Print Q Transferred.")
- +2 ; Old global node
- KILL ^%ZTSK(Y)
- END2 ;
- +1 KILL L,D,T,S,Y
- +2 KILL ^TMP("ACHSYPQM",$JOB)
- +3 QUIT
- +4 ;